├── t ├── test-delete-paren-reader.lisp ├── test-indicator-preserve-case.lisp ├── test-delete-all-paren-readers.lisp ├── test.lisp └── illusion.lisp ├── illusion-test.asd ├── illusion.asd ├── src └── illusion.lisp └── README.md /t/test-delete-paren-reader.lisp: -------------------------------------------------------------------------------- 1 | (in-package :illusion.test) 2 | 3 | (in-readtable :illusion-readtable) 4 | 5 | (in-suite delete-paren-reader) 6 | 7 | (eval-when (:load-toplevel :compile-toplevel :execute) 8 | (delete-paren-reader :html)) 9 | 10 | (test delete-single-paren-reader 11 | (is (equal '(div#main) 12 | (read-from-string "(div#main)")))) 13 | 14 | (run! 'delete-single-paren-reader) 15 | 16 | (in-suite default) 17 | (run! 'case-sensitive-cmd-line) 18 | -------------------------------------------------------------------------------- /illusion-test.asd: -------------------------------------------------------------------------------- 1 | (defsystem illusion-test 2 | :author "Bo Yao " 3 | :license "MIT" 4 | :depends-on (:illusion :fiveam :split-sequence) 5 | :components ((:module "t" 6 | :serial t 7 | :components 8 | ((:file "illusion") 9 | (:file "test") 10 | (:file "test-indicator-preserve-case") 11 | (:file "test-delete-paren-reader") 12 | (:file "test-delete-all-paren-readers"))))) 13 | -------------------------------------------------------------------------------- /illusion.asd: -------------------------------------------------------------------------------- 1 | (defsystem illusion 2 | :author "Bo Yao " 3 | :license "MIT" 4 | :version "0.1" 5 | :components ((:module "src" 6 | :serial t 7 | :components 8 | ((:file "illusion")))) 9 | :description "Customize and manage Lisp parens reader" 10 | :long-description 11 | #.(uiop:read-file-string 12 | (uiop:subpathname *load-pathname* "README.md")) 13 | :in-order-to ((test-op (test-op illusion-test))) 14 | :depends-on (:named-readtables :alexandria :let-over-lambda)) 15 | -------------------------------------------------------------------------------- /t/test-indicator-preserve-case.lisp: -------------------------------------------------------------------------------- 1 | (in-package :illusion.test) 2 | 3 | (in-readtable :illusion-readtable) 4 | 5 | (in-suite indicator-preserve-case) 6 | 7 | (set-indicator-mode :preserve-case) 8 | 9 | (test commonqt-methods 10 | (is (equal (list 'OPTIMIZED-CALL T 'PAINTER "setBrush" "Brush name") 11 | (read-from-string "(setBrush painter \"Brush name\")"))) 12 | (is (equal '(if (some-func a) 13 | (aa) 14 | (bb)) 15 | (read-from-string "(if (some-func a) 16 | (aa) 17 | (bb))")))) 18 | 19 | (run! 'indicator-preserve-case) 20 | (set-indicator-mode :standard) 21 | -------------------------------------------------------------------------------- /t/test-delete-all-paren-readers.lisp: -------------------------------------------------------------------------------- 1 | (in-package :illusion.test) 2 | 3 | (in-readtable :illusion-readtable) 4 | 5 | (in-suite delete-paren-reader) 6 | 7 | (eval-when (:load-toplevel :compile-toplevel :execute) 8 | (delete-all-paren-readers)) 9 | 10 | (test delete-all-paren-readers 11 | (is (equal (cons 'stub-cli:define-cli 12 | '(cli-name 13 | (v version "Show version") 14 | (v verbose "Set verbose level"))) 15 | (read-from-string "(stub-cli:define-cli cli-name 16 | (v version \"Show version\") 17 | (V verbose \"Set verbose level\"))")))) 18 | 19 | (run! 'delete-all-paren-readers) 20 | -------------------------------------------------------------------------------- /t/test.lisp: -------------------------------------------------------------------------------- 1 | (in-package :illusion.test) 2 | 3 | (in-readtable :illusion-readtable) 4 | 5 | (def-suite default) 6 | (def-suite indicator-preserve-case) 7 | (def-suite delete-paren-reader) 8 | 9 | (in-suite default) 10 | 11 | (test corner-case 12 | (is (eql () (read-from-string "()"))) 13 | (is (eql :reader-error 14 | (handler-case (read-from-string ")") 15 | (reader-error () :reader-error))))) 16 | 17 | (test case-sensitive-cmd-line 18 | (is (equal (cons 'stub-cli:define-cli 19 | '(cli-name 20 | (|v| |version| "Show version") 21 | (v |verbose| "Set verbose level"))) 22 | (read-from-string "(stub-cli:define-cli cli-name 23 | (v version \"Show version\") 24 | (V verbose \"Set verbose level\"))"))) 25 | (is (equal (list '|SOMETHING-ELSE| '(|A| |A| |a| |A| (|b| |B| |B| |B|))) 26 | (read-from-string "(something-else (a A \\a \\A (\\b \\B B b)))")))) 27 | 28 | (test html-ids 29 | (is (equal (list 'stub-html:div :id "main") 30 | (read-from-string "(div#main)"))) 31 | (is (equal (list 'div "something") 32 | (read-from-string "(div \"something\")"))) 33 | (is (equal '(|SOMETHING-ELSE| \A \B 3 "a") 34 | (read-from-string "(something-else a b 3 \"a\")")))) 35 | 36 | (run! 'default) 37 | -------------------------------------------------------------------------------- /t/illusion.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage illusion.test 3 | (:use :cl :illusion :fiveam) 4 | (:import-from :named-readtables 5 | :in-readtable) 6 | (:import-from :split-sequence 7 | :split-sequence)) 8 | 9 | (defpackage stub-cli 10 | (:use :cl) 11 | (:export :define-cli)) 12 | 13 | (defpackage stub-html 14 | (:use :cl) 15 | (:export :div :a :canvas :code)) 16 | 17 | (defpackage stub-commonqt 18 | (:use :cl) 19 | (:export :optimized-call)) 20 | 21 | (in-package :illusion.test) 22 | 23 | (in-readtable :illusion-readtable) 24 | 25 | (set-paren-reader :define-cli 26 | (lambda (i) 27 | (eql i 'stub-cli:define-cli)) 28 | (lambda (stream indicator) 29 | (cons 'stub-cli:define-cli 30 | (cons (read stream) 31 | (with-reader-case :preserve 32 | (cl-read-list stream)))))) 33 | 34 | (set-paren-reader :html 35 | (lambda (i) 36 | (when (symbolp i) 37 | (let ((name (symbol-name i))) 38 | (when (find #\# name) 39 | (let ((name-and-id (split-sequence #\# name))) 40 | (multiple-value-bind (symbol access) (find-symbol (first name-and-id) :stub-html) 41 | (eql access :external))))))) 42 | (lambda (stream indicator) 43 | (let ((name-and-id (split-sequence #\# (symbol-name indicator)))) 44 | (list* (find-symbol (first name-and-id) :stub-html) 45 | :id (string-downcase (second name-and-id)) 46 | (cl-read-list stream))))) 47 | 48 | (defun qt-symbol-p (sym) 49 | (and (symbolp sym) 50 | (find sym '(|new| |moveCenter| |isActive| |setBrush|)))) 51 | 52 | (set-paren-reader :commonqt 53 | #'qt-symbol-p 54 | (lambda (stream indicator) 55 | (list* 'optimized-call t (read stream) (symbol-name indicator) 56 | (cl-read-list stream)))) 57 | -------------------------------------------------------------------------------- /src/illusion.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage illusion 3 | (:use :cl) 4 | (:import-from :named-readtables 5 | :defreadtable 6 | :find-readtable) 7 | (:import-from :alexandria 8 | :if-let 9 | :when-let) 10 | (:import-from :let-over-lambda 11 | :defmacro!) 12 | (:export :set-paren-reader 13 | :delete-paren-reader 14 | :delete-all-paren-readers 15 | :set-indicator-mode 16 | :cl-read-list 17 | :with-reader-case)) 18 | (in-package :illusion) 19 | 20 | (defstruct paren-reader name predicate reader) 21 | 22 | (defvar *indicator-reader* #'read) 23 | 24 | (defvar *indicator-fallback* #'identity) 25 | 26 | (defvar *paren-readers* nil) 27 | 28 | (defvar *in-list-p* nil) 29 | 30 | (defvar +empty-list+ (gensym "EMPTY-LIST")) 31 | 32 | (defun cl-read-list (stream) 33 | (funcall (get-macro-character #\( (find-readtable :standard)) 34 | stream 35 | #\()) 36 | 37 | (defun cl-read-right-paren (stream) 38 | (funcall (get-macro-character #\) (find-readtable :standard)) 39 | stream 40 | #\))) 41 | 42 | (defun find-paren-reader (indicator) 43 | (when-let (paren-reader 44 | (find-if (lambda (paren-reader) 45 | (funcall (paren-reader-predicate paren-reader) indicator)) 46 | *paren-readers*)) 47 | (paren-reader-reader paren-reader))) 48 | 49 | (defun paren-reader-name-matcher (name) 50 | (lambda (paren-reader) 51 | (eql (paren-reader-name paren-reader) name))) 52 | 53 | (defun find-paren-reader-by-name (name) 54 | (find-if (paren-reader-name-matcher name) 55 | *paren-readers*)) 56 | 57 | (defun illusion-read-list (stream ignore) 58 | (declare (ignore ignore)) 59 | (let* ((*in-list-p* t) 60 | (indicator (funcall *indicator-reader* stream))) 61 | (unless (eql indicator +empty-list+) 62 | (if-let (reader (find-paren-reader indicator)) 63 | (funcall reader stream indicator) 64 | (cons (funcall *indicator-fallback* indicator) (cl-read-list stream)))))) 65 | 66 | (defun illusion-read-right-paren (stream right-paren) 67 | (if *in-list-p* 68 | +empty-list+ 69 | (cl-read-right-paren stream))) 70 | 71 | (defun set-paren-reader (name predicate reader) 72 | (if-let (paren-reader (find-paren-reader-by-name name)) 73 | (setf (paren-reader-predicate paren-reader) predicate 74 | (paren-reader-reader paren-reader) reader) 75 | (push (make-paren-reader :name name :predicate predicate :reader reader) 76 | *paren-readers*))) 77 | 78 | (defun delete-paren-reader (name) 79 | (setf *paren-readers* (delete-if (paren-reader-name-matcher name) *paren-readers*))) 80 | 81 | (defun delete-all-paren-readers () 82 | (setf *paren-readers* nil)) 83 | 84 | (defmacro! with-reader-case (case &body body) 85 | `(let ((,g!previous-case (readtable-case *readtable*))) 86 | (setf (readtable-case *readtable*) ,case) 87 | (unwind-protect (progn ,@body) 88 | (setf (readtable-case *readtable*) ,g!previous-case)))) 89 | 90 | (defun read-indicator-preserve-case (stream) 91 | (with-reader-case :preserve (read stream))) 92 | 93 | (defun fallback-indicator-upcase (indicator) 94 | (if (and (symbolp indicator)) 95 | (intern (string-upcase indicator) (symbol-package indicator)) 96 | indicator)) 97 | 98 | (defun funcallable-p (name) 99 | (or (functionp name) 100 | (and (symbolp name) 101 | (fboundp name)))) 102 | 103 | (defun set-indicator-mode (mode) 104 | (ecase (type-of mode) 105 | ((keyword) 106 | (ecase mode 107 | (:preserve-case (setf *indicator-reader* #'read-indicator-preserve-case 108 | *indicator-fallback* #'fallback-indicator-upcase)) 109 | (:standard (setf *indicator-reader* #'read 110 | *indicator-fallback* #'identity)))) 111 | ((cons) 112 | (assert (and (funcallable-p (car mode)) (funcallable-p (cdr mode)))) 113 | (setf *indicator-reader* (car mode) 114 | *indicator-fallback* (cdr mode))))) 115 | 116 | (defreadtable :illusion-readtable 117 | (:merge :standard) 118 | (:macro-char #\( #'illusion-read-list) 119 | (:macro-char #\) #'illusion-read-right-paren)) 120 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Illusion 2 | 3 | Illusion is a library for customization and management of Lisp left paren reader. 4 | 5 | # Overview 6 | 7 | - Adding customized left paren reader macro, based on indicator (first element of list); 8 | - Automatically use left paren reader macro when indicator satisfies user defined predicate; 9 | - Optionally read indicator in case sensitive or customized mode and still read the rest with default reader behavior 10 | - Delete paren left paren reader even they break reader behavior. 11 | 12 | Why customize the reader macro of left paren? Some features are impossible without doing that, let's see a few short examples in [Usage](#Usage) section. 13 | 14 | # Usage 15 | ## Installation and import 16 | Before illusion available in quicklisp, clone this repo to `local-projects` or adding to `asdf:*central-registry*` and: 17 | ```lisp 18 | (ql:quickload :illusion) 19 | ``` 20 | If you don't use other customized reader macros, just use `:illusion-readtable`: 21 | ```lisp 22 | (named-readtables:in-readtable :illusion-readtable) 23 | ``` 24 | Otherwise, merge `:illusion-readtable` into current one, it only changes definition of `#\(` and `#\)`: 25 | ```lisp 26 | (handler-bind ((named-readtables:reader-macro-conflict #'continue)) 27 | (named-readtables:merge-readtables-into your-readtable :illusion-readtable)) 28 | ``` 29 | ## Set and delete a left paren reader 30 | ```lisp 31 | (illusion:set-paren-reader name predicate reader) 32 | ``` 33 | 34 | Use a `SET-PAREN-READER` to add or change a left paren reader. `NAME` is a keyword to identify and you can delete it by `(DELETE-PAREN-READER NAME)`. `PREDICATE` is a function `INDICATOR -> BOOLEAN`. Indicator is the first element of every list. It's not necessarilly a symbol and first element of a list literal, e.g. `a` in `(a b)` is also indicator. So we must carefully check the condition that indicator satisfies in `PREDICATE`. And at last, `READER` is the function `(STREAM INDICATOR) -> OBJECT` that called when `(PREDICATE INDICATOR)` satisfied. Current position of input `STREAM` is just after read `INDICATOR`. 35 | 36 | 37 | ## Examples 38 | ### Temporarily change to preserve case reader after specific indicator 39 | The first example, assume we want to write a `DEFINE-CLI` which take command line specs and produce a command line argument parser. The command line option is usually case sensitive, so this won't work: 40 | ```lisp 41 | (define-cli :main 42 | (v version "Display version of this program") 43 | (V verbose "Set verbose level")) 44 | ``` 45 | `v` and `V` will both read to `V`. We can use `"v"`, `#\v`, `\v` or `|v|`, but each one is more verbose. Or we can `(setf (readtable-case *readtable*) :preserve)`, but this force us to use upcase symbols for all CL symbols. What if the reader auto turns on preserve case after encounter `DEFINE-CLI` indicator? We can define it as: 46 | ```lisp 47 | (set-paren-reader :define-cli 48 | (lambda (i) 49 | (eql i 'stub-cli:define-cli)) 50 | (lambda (stream indicator) 51 | (cons 'stub-cli:define-cli 52 | (cons (read stream) 53 | (with-reader-case :preserve 54 | (cl-read-list stream)))))) 55 | ``` 56 | A few note about this left paren reader: 57 | - To compare with a symbol, must given the symbol with its package name like `STUB-CLI:DEFINE-CLI` 58 | - The reader (third parameter of `SET-PAREN-READER` should return newly cons list. Avoid using `'` or backquote. Because sometimes they create lists with shared structure and cause strange behavior. 59 | - `ILLUSION:WITH-READER-CASE` is a trivial but handy utility, that executing the body with `(READTABLE-CASE *READTABLE*)` bind to one of `:UPCASE`, `:DOWNCASW`, `:PRESERVE` or `:INVERSE`, and unwind to previous `(READTABLE-CASE *READTABLE*)` setting after leave it. 60 | - If you want this left paren make effect in current file, need to wrap `(set-paren-reader ...)` inside `(eval-when (:compile-toplevel :load-toplevel :execute) ...)` like changing other reader macros. 61 | 62 | This only saving a little effort when define cli, but similar techniques can be helpful in accessing case sensitive foreign languages. For example, inline calling a JavaScript method as that in ClojureScript and inline calling a Qt method as if in C++. 63 | 64 | ### Inline calling CommonQt methods 65 | Calling a CommonQt method need a `#_` reader macro: 66 | ```lisp 67 | (#_setBrush painter "brush name") 68 | ``` 69 | Using [https://github.com/commonqt/commonqt](CommonQt) methods a lot is not very pleasant because of many `#_`. If we're doing GUI programming with CommonQt, usually it make sense to have a whole package dedicated to UI definition and event handling. With the following left paren reader, we can use CommonQt methods as if using Common Lisp functions while let Common Lisp's package system and illusion do the symbol isolation: 70 | ```lisp 71 | (set-paren-reader :commonqt 72 | #'qt-symbol-p 73 | (lambda (stream indicator) 74 | (list* 'optimized-call t (read stream) (symbol-name indicator) 75 | (cl-read-list stream)))) 76 | ``` 77 | 78 | Here `(optimized-call t obj "methodName" arg1 arg2)` is how CommonQt call Qt Method `(#_methodName obj arg1 arg2)` and after this `SET-PAREN-READER` we can simply use `(|methodName obj arg1 arg2)`. Even better, we can use `(ILLUSION:SET-INDICATOR-MODE :PRESERVE-CASE)` then just `(methodName obj arg1 arg2)`. 79 | In this indicator mode, it will first try the preserve case symbol and check if it satisfies any left paren reader predicate. If none, indicator will fallback to upcase, so all existing Common Lisp and user package symbols still works. In rare case if you have lower and mixed case symbol as function/macro names, try to isolate them with the scope that using CommonQt. 80 | ### CSS id and class attached to html element creation function name 81 | In [https://github.com/ailisp/flute](flute) html generation library, HTML elements are defined with same name functions. `(div ...)` will create a div element. It's almost shortest possible way to generate html in Common Lisp, but with illusion, we can support haml and hiccup style id/class attached to function names like `(div#my-div.class1.class2 ...)`. To keep example short, we only process id here and writing this left paren reader for a sub-html package, assume stub-html package has `DIV` exported: 82 | ``` 83 | (set-paren-reader :html 84 | (lambda (i) 85 | (when (symbolp i) 86 | (let ((name (symbol-name i))) 87 | (when (find #\# name) 88 | (let ((name-and-id (split-sequence #\# name))) 89 | (multiple-value-bind (symbol access) (find-symbol (first name-and-id) :stub-html) 90 | (eql access :external))))))) 91 | (lambda (stream indicator) 92 | (let ((name-and-id (split-sequence #\# (symbol-name indicator)))) 93 | (list* (find-symbol (first name-and-id) :stub-html) 94 | :id (string-downcase (second name-and-id)) 95 | (cl-read-list stream))))) 96 | ``` 97 | ## Set indicator mode 98 | As showed in the CommonQt example, illusion support `SET-INDICATOR-MODE`. Currently `:STANDARD` (default), `:PRESERVE-CASE` and `(INDICATOR-READER . INDICATOR-FALLBACK)` is supported. `INDICATOR-READER` is a function take a stream as only required argument and return the indicator it reads. `INDICATOR-FALLBACK` is a function called when indicator not satisfied any left paren reader and take indicator as only argument, returns the object that `CL:READ` would return when reading that indicator. 99 | 100 | # Motivation 101 | 102 | Illusion will obviously lead to more obscure code. It won't slow down the generated program since it all happens at read time. But if carefully used, the syntax can be further simplified and gives an illusion of having a more versatile ability with using plain parens. The example usages above are real usage in [flute](https://github.com/ailisp/flute) for html generation and [lispy-cli](https://github.com/ailisp/lispy-cli). Hope illusion also help construct easier usage of your library! 103 | 104 | # License 105 | 106 | Licensed under the MIT License. 107 | Copyright (c) 2018, Bo Yao. All rights reserved. 108 | --------------------------------------------------------------------------------