((^a (* a a)) 2) ; -> 4

paren-caret-reader.lisp

(defvar *org-readtable* *readtable*)
(defvar *org-paren-reader*
  (get-macro-character #\( (copy-readtable nil)))

(defun mklist (obj)
  (if (atom obj) (list obj) obj))

(defun paren-caret-reader (stream char)
  (let ((c (read-char stream t nil t)))
    (if (char= #\^ c)
      (let ((rest #1=(funcall *org-paren-reader* stream char)))
	(list* 'lambda (mklist (car rest)) (cdr rest)))
      (progn (unread-char c stream) #1#))))

(defvar *caret-readtable*
  (let ((tbl (copy-readtable)))
    (set-macro-character #\( #'paren-caret-reader nil tbl)
    tbl))

(defun toggle-caret-reader ()
  (setq *readtable*
	(if (eq *org-readtable* *readtable*)
	    *caret-readtable*
	  *org-readtable*)))

(defparameter caret-test-forms
  (list
   "(mapcar (^a(* a a)) '(1 2 3 4 5))"
   "((^(x y)(sqrt (+ (* x x) (* y y)))) 3 4)"
   "((^_`((^_,_)',_))'`((^_,_)',_))"
   ))

(defun caret-test ()
  (let ((*readtable* *caret-readtable*))
    (dolist (s caret-test-forms)
      (let ((f (read-from-string s)))
	(format t "~A~%-> ~S~%-> ~A~%~%" s f (eval f))))))