syntax.lisp

   1 (in-package :cl-tuples)
   2
   3 ;; to do -- investigate cl-syntax-sugar to see if we can come up with
   4 ;; some nicer custom syntax
   5
   6 ;; make #{ .. } notation become a short hand for (values ...)
   7 (defun |#{-reader| (stream char arg)
   8   (declare (ignore char arg))
   9   `(values ,@(read-delimited-list #\} stream t)))
  10
  11 (defvar *original-readtable* NIL)
  12
  13 (defvar *restore-reader-syntax* NIL)
  14
  15 (defmacro disable-tuples-syntax ()
  16   '(eval-when (:compile-toplevel :load-toplevel :execute)
  17     (setf *restore-reader-syntax* NIL)
  18     (%disable-tuples-syntax)))
  19
  20 (defmacro locally-disable-tuples-syntax ()
  21   '(eval-when (:compile-toplevel :load-toplevel :execute)
  22     (%disable-tuples-syntax)))
  23
  24 (defun %disable-tuples-syntax ()
  25   (when *original-readtable*
  26     (setf *readtable* *original-readtable*
  27           *original-readtable* NIL))
  28   (values))
  29
  30 (defmacro enable-tuples-syntax ()
  31   '(eval-when (:compile-toplevel :load-toplevel :execute)
  32     (setf *restore-reader-syntax* T)
  33     (%enable-tuples-syntax)))
  34
  35 (defmacro locally-enable-tuples-syntax ()
  36   '(eval-when (:compile-toplevel :load-toplevel :execute)
  37     (%enable-tuples-syntax)))
  38
  39 (defmacro file-enable-tuples-syntax ()
  40   '(eval-when (:compile-toplevel :load-toplevel :execute)
  41     (%enable-tuples-syntax NIL)))
  42
  43 (defun %enable-tuples-syntax (&optional (save-original-p T))
  44   (when save-original-p
  45     (setf *original-readtable* (copy-readtable)))
  46   (when (or (not save-original-p) *original-readtable*)
  47     (setf *readtable* (copy-readtable))
  48     (set-dispatch-macro-character #\# #\{ #'|#{-reader|)
  49     (set-macro-character #\} (get-macro-character #\) nil)))
  50   (values))
  51
  52 (defmacro restore-tuples-syntax-state ()
  53   '(eval-when (:compile-toplevel :load-toplevel :execute)
  54     (if *restore-tuples-syntax*
  55         (%enable-tuples-syntax)
  56         (%disable-tuples-syntax))))