Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
(Ab)Using Language Features: The Common Lisp Condition System
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment