(Ab)Using Language Features: The Common Lisp Condition System

abusing-restarts.lisp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This script works with GNU CLISP but may not work with other
;; implementations since the restarts which are provided are
;; implementation dependant.  This will *not* work when compiled
;; since CLISP removes the use-value restart in compiled code.
;;
;; This script also uses quicklisp to load several third party
;; libraries (see http://www.quicklisp.org)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; C-Style Hex Literals
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(ql:quickload :cl-ppcre)

(defun hex-val (str)
  "If a string looks like a hex string (like \"0x100\"), returns
   the numeric value it represents.  Else return nil."
  (multiple-value-bind (match regs)
      (cl-ppcre:scan-to-strings "^0[xX]([0-9a-fA-F]+)$" str)
    (if match
      (parse-integer (aref regs 0) :radix 16)
      nil)))

(defun c-like-hex-literal-handler (condition)
  "Given an unbound-variable condition, invokes the use-value
   restart if the \"variable\" looks like a hex value."
  (let* ((var-name (symbol-name (cell-error-name condition)))
         (val (hex-val var-name)))
    (when val
      (invoke-restart 'use-value val))))

(defmacro with-hex-literals (&body body)
  "Execute code within an environment where c-style hex literals
   can be used (0x100, 0xFFFFFFFF) instead of the common lisp
   hex literals (#x100, #xFFFFFFFF)"
  `(handler-bind ((unbound-variable #'c-like-hex-literal-handler))
     ,@body))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Limited Infix Notation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(ql:quickload :infix)

(defun infix-val (str)
  "Try to evaluate a string as an infix expression and returns
   its result (or nil if this fails)."
  (let ((infix-form (handler-case (infix:string->prefix str)
                      (condition () nil))))
    (when infix-form
      (eval infix-form))))
    
(defun infix-literal-handler (condition)
  "Given an unbound-variable condition, invokes the use-value
   restart if the \"variable\" looks like an infix expression."
  (let* ((var-name (symbol-name (cell-error-name condition)))
         (val (infix-val var-name)))
    (when val
      (invoke-restart 'use-value val))))

(defmacro with-infix-literals (&body body)
  "Execute code within an environment where simple infix
   expressions can be used (like 1+1, 1+3/pi, etc).  Note that
   there cannot be any spaces in the infix expression."
  `(handler-bind ((unbound-variable #'infix-literal-handler))
     ,@body))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supreme Abuse
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(ql:quickload :infix)

(defmacro with-crazy-stuff (&body body)
  "Execute code within an environment where both infix literals
   and c-style hex literals can be used."
  `(with-hex-literals
     (with-infix-literals
       ,@body)))