# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1776090098 14400
# Node ID 1f56f1f1a43d0b0265291d38583baec5a72cce4f
# Parent  205427feb9feb7297ca2c70cf6f0c86b452784b6
Update to get running again in 2026

diff -r 205427feb9fe -r 1f56f1f1a43d cl-chip8.asd
--- a/cl-chip8.asd	Sun Aug 06 20:29:52 2017 -0400
+++ b/cl-chip8.asd	Mon Apr 13 10:21:38 2026 -0400
@@ -8,6 +8,7 @@
   :version "1.0.0"
 
   :depends-on (
+               :alexandria
                :bordeaux-threads
                :cl-opengl
                :cl-portaudio
@@ -20,10 +21,7 @@
                )
 
   :serial t
-  :components ((:module "vendor" :serial t
-                :components ((:file "quickutils-package")
-                             (:file "quickutils")))
-               (:file "package")
+  :components ((:file "package")
                (:module "src" :serial t
                 :components ((:file "debugger")
                              (:file "emulator")
diff -r 205427feb9fe -r 1f56f1f1a43d package.lisp
--- a/package.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ b/package.lisp	Mon Apr 13 10:21:38 2026 -0400
@@ -1,16 +1,10 @@
 (defpackage :chip8
-  (:use
-    :cl
-    :losh
-    :iterate
-    :chip8.quickutils)
+  (:use :cl :losh :iterate)
   (:export))
 
 
 (defpackage :chip8.gui.screen
-  (:use :cl+qt :iterate :losh
-    :chip8.quickutils))
+  (:use :cl+qt :iterate :losh))
 
 (defpackage :chip8.gui.debugger
-  (:use :cl+qt :iterate :losh
-    :chip8.quickutils))
+  (:use :cl+qt :iterate :losh))
diff -r 205427feb9fe -r 1f56f1f1a43d src/debugger.lisp
--- a/src/debugger.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ b/src/debugger.lisp	Mon Apr 13 10:21:38 2026 -0400
@@ -8,7 +8,7 @@
   (callbacks-arrived nil :type list)
   (breakpoints nil :type list))
 
-(define-with-macro debugger
+(define-with-macro (debugger :conc-name debugger-)
   paused take-step awaiting-arrival
   callbacks-arrived)
 
@@ -164,7 +164,7 @@
   (pushnew address (debugger-breakpoints debugger)))
 
 (defun debugger-remove-breakpoint (debugger address)
-  (removef (debugger-breakpoints debugger) address))
+  (alexandria:removef (debugger-breakpoints debugger) address))
 
 (defun debugger-add-callback-arrived (debugger function)
   (push function (debugger-callbacks-arrived debugger))
diff -r 205427feb9fe -r 1f56f1f1a43d src/declarations.lisp
--- a/src/declarations.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,46 +0,0 @@
-(in-package :chip8)
-
-
-(declaim
-  (ftype (function (chip)) load-font)
-  (ftype (function (chip fixnum fixnum)) wrap)
-  (ftype (function (chip int8 int8 int4) null) draw-sprite)
-  (ftype (function (chip (integer (16)))) keyup keydown)
-  (ftype (function (single-float) single-float) square saw)
-  (ftype (function (chip) null) run-sound)
-  (ftype (function (chip) null) decrement-timers run-timers)
-  (ftype (function (chip) null) run-cpu emulate-cycle)
-  (ftype (function (chip int16) null) dispatch-instruction)
-  (ftype (function (chip)) reset)
-  ; (ftype (function ()))
-  )
-
-(defun draw-sprite (chip start-x start-y size)
-  (declare (type chip chip)
-           (type int8 start-x start-y)
-           (type int4 size))
-  (with-chip (chip)
-    (setf flag 0)
-    (iterate
-      (declare (iterate:declare-variables))
-      (repeat size)
-      (for (the fixnum i) :from index)
-      (for (the fixnum y) :from start-y)
-      (for sprite = (aref memory i))
-      (iterate
-        (declare (iterate:declare-variables))
-        (for (the fixnum x) :from start-x)
-        (for (the fixnum col) :from 7 :downto 0)
-        (multiple-value-bind (x y draw) (wrap chip x y)
-          (when draw
-            (for old-pixel = (plusp (vref chip x y)))
-            (for new-pixel = (plusp (get-bit col sprite)))
-            (when (and old-pixel new-pixel)
-              (setf flag 1))
-            (setf (vref chip x y)
-                  (if (xor old-pixel new-pixel) 255 0))))))
-    (setf video-dirty t))
-  nil)
-
-; (start-profiling)
-; (stop-profiling)
diff -r 205427feb9fe -r 1f56f1f1a43d src/emulator.lisp
--- a/src/emulator.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ b/src/emulator.lisp	Mon Apr 13 10:21:38 2026 -0400
@@ -1,6 +1,6 @@
 (in-package :chip8)
-(declaim (optimize (speed 3) (safety 0) (debug 0)))
-; (declaim (optimize (speed 3) (safety 1) (debug 2)))
+;; (declaim (optimize (speed 3) (safety 0) (debug 0)))
+(declaim (optimize (speed 1) (safety 1) (debug 1)))
 
 
 ;;;; Constants ----------------------------------------------------------------
@@ -19,9 +19,6 @@
 
 
 ;;;; Utils --------------------------------------------------------------------
-(defun-inline not= (x y)
-  (not (= x y)))
-
 (defun-inline chop (size integer)
   (ldb (byte size 0) integer))
 
@@ -84,7 +81,7 @@
   (loaded-rom nil :type (or null string))
   (debugger (make-debugger) :type debugger :read-only t))
 
-(define-with-macro chip
+(define-with-macro (chip :conc-name chip-)
   running
   memory
   registers flag index program-counter
@@ -166,7 +163,7 @@
                    (when (and old-pixel new-pixel)
                      (setf flag 1))
                    (setf (vref chip x y)
-                         (if (xor old-pixel new-pixel) 255 0))))))
+                         (if (alexandria:xor old-pixel new-pixel) 255 0))))))
     (setf video-dirty t))
   nil)
 
@@ -260,9 +257,9 @@
 (macro-map                                              ;; SE/SNE
   (NAME            TEST X-ARG  X-FORM        Y-ARG         Y-FORM)
   ((op-se-reg-imm  =    (r 1)  (register r)  (immediate 2) immediate)
-   (op-sne-reg-imm not= (r 1)  (register r)  (immediate 2) immediate)
+   (op-sne-reg-imm /=   (r 1)  (register r)  (immediate 2) immediate)
    (op-se-reg-reg  =    (rx 1) (register rx) (ry 1)        (register ry))
-   (op-sne-reg-reg not= (rx 1) (register rx) (ry 1)        (register ry)))
+   (op-sne-reg-reg /=   (rx 1) (register rx) (ry 1)        (register ry)))
   `(define-instruction ,name (_ ,x-arg ,y-arg)
     (when (,test ,x-form ,y-form)
       (incf program-counter 2))))
@@ -458,7 +455,7 @@
     (fill keys nil)
     (fill video 0)
     (load-font chip)
-    (replace memory (read-file-into-byte-vector loaded-rom)
+    (replace memory (alexandria:read-file-into-byte-vector loaded-rom)
              :start1 #x200)
     (setf running t
           video-dirty t
@@ -530,6 +527,7 @@
 
 (defun run-cpu (chip)
   (iterate
+    (declare (ignorable tick))
     (while (chip-running chip))
     (emulate-cycle chip)
     (for tick :every-nth +cycles-before-sleep+ :do
diff -r 205427feb9fe -r 1f56f1f1a43d src/gui/debugger.lisp
--- a/src/gui/debugger.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ b/src/gui/debugger.lisp	Mon Apr 13 10:21:38 2026 -0400
@@ -33,9 +33,9 @@
 ;;;; Disassembler -------------------------------------------------------------
 ;;;; Code
 (defun disassemble-address (chip address)
-  (-<> chip
+  (_ chip
     chip8::chip-memory
-    (chip8::instruction-information <> address)))
+    (chip8::instruction-information _ address)))
 
 
 ;;;; Model
@@ -46,10 +46,10 @@
 
 
 (defun disassembly-model-address-to-row (model address)
-  (-<> address
-    (+ <> (slot-value model 'parity))
-    (truncate <> 2)
-    (values <>)))
+  (_ address
+    (+ _ (slot-value model 'parity))
+    (truncate _ 2)
+    (values _)))
 
 
 (defun disassembly-model-update-current-address (model new-address)
@@ -83,11 +83,11 @@
        (< (q+:row index) (ceiling 4096 2))))
 
 (defun get-disassembly-contents (model row col)
-  (let ((data (-<> model
-                (slot-value <> 'chip)
-                (disassemble-address <> (- (* 2 row)
-                                           (slot-value model 'parity)))
-                (nth col <>))))
+  (let ((data (_ model
+                (slot-value _ 'chip)
+                (disassemble-address _ (- (* 2 row)
+                                          (slot-value model 'parity)))
+                (nth col _))))
     (ecase col
       (0 (format nil "~3,'0X" data))
       (1 (format nil "~4,'0X" data))
@@ -137,16 +137,16 @@
 ;;;; Layout
 (defun disassembly-update-address (model view address)
   (disassembly-model-update-current-address model address)
-  (-<> address
+  (_ address
     ;; raw address -> row number
-    (disassembly-model-address-to-row model <>)
+    (disassembly-model-address-to-row model _)
     ;; Give ourselves a bit of breathing room at the top of the table
-    (- <> 4)
-    (max <> 0)
+    (- _ 4)
+    (max _ 0)
     ;; get a QModelIndex, because passing a pair of ints would be too easy
-    (model-index model <> 0)
+    (model-index model _ 0)
     ;; make the debugger show the current line
-    (q+:scroll-to view <> (q+:qabstractitemview.position-at-top))))
+    (q+:scroll-to view _ (q+:qabstractitemview.position-at-top))))
 
 (define-subwidget (debugger disassembly-table)
     (q+:make-qtableview debugger)
diff -r 205427feb9fe -r 1f56f1f1a43d src/gui/screen.lisp
--- a/src/gui/screen.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ b/src/gui/screen.lisp	Mon Apr 13 10:21:38 2026 -0400
@@ -108,7 +108,7 @@
   (q+:end-native-painting painter))
 
 (defun render-debug (screen painter)
-  (when (-<> screen screen-chip chip8::chip-debugger chip8::debugger-paused)
+  (when (_ screen screen-chip chip8::chip-debugger chip8::debugger-paused)
          (with-finalizing* ((font (q+:make-qfont "Menlo" 20))
                             (border-color (q+:make-qcolor 255 255 255))
                             (fill-color (q+:make-qcolor 0 0 0))
@@ -135,72 +135,72 @@
     (render-debug screen painter)))
 
 
-(defun pad-key-for (code)
-  ;; Original Chip-8 Pad → Modern Numpad
-  ;; ┌─┬─┬─┬─┐             ┌─┬─┬─┬─┐
-  ;; │1│2│3│C│             │←│/│*│-│
-  ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
-  ;; │4│5│6│D│             │7│8│9│+│
-  ;; ├─┼─┼─┼─┤             ├─┼─┼─┤ │
-  ;; │7│8│9│E│             │4│5│6│ │
-  ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
-  ;; │A│0│B│F│             │1│2│3│↲│
-  ;; └─┴─┴─┴─┘             ├─┴─┼─┤ │
-  ;;                       │0  │.│ │
-  ;;                       └───┴─┴─┘
-  (qtenumcase code
-    ((q+:qt.key_clear) #x1)
-    ((q+:qt.key_slash) #x2)
-    ((q+:qt.key_asterisk) #x3)
-    ((q+:qt.key_minus) #xC)
+;; (defun pad-key-for (code)
+;;   ;; Original Chip-8 Pad → Modern Numpad
+;;   ;; ┌─┬─┬─┬─┐             ┌─┬─┬─┬─┐
+;;   ;; │1│2│3│C│             │←│/│*│-│
+;;   ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
+;;   ;; │4│5│6│D│             │7│8│9│+│
+;;   ;; ├─┼─┼─┼─┤             ├─┼─┼─┤ │
+;;   ;; │7│8│9│E│             │4│5│6│ │
+;;   ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
+;;   ;; │A│0│B│F│             │1│2│3│↲│
+;;   ;; └─┴─┴─┴─┘             ├─┴─┼─┤ │
+;;   ;;                       │0  │.│ │
+;;   ;;                       └───┴─┴─┘
+;;   (qtenumcase code
+;;     ((q+:qt.key_clear) #x1)
+;;     ((q+:qt.key_slash) #x2)
+;;     ((q+:qt.key_asterisk) #x3)
+;;     ((q+:qt.key_minus) #xC)
 
-    ((q+:qt.key_7) #x4)
-    ((q+:qt.key_8) #x5)
-    ((q+:qt.key_9) #x6)
-    ((q+:qt.key_plus) #xD)
+;;     ((q+:qt.key_7) #x4)
+;;     ((q+:qt.key_8) #x5)
+;;     ((q+:qt.key_9) #x6)
+;;     ((q+:qt.key_plus) #xD)
 
-    ((q+:qt.key_4) #x7)
-    ((q+:qt.key_5) #x8)
-    ((q+:qt.key_6) #x9)
-    ((q+:qt.key_enter) #xE)
+;;     ((q+:qt.key_4) #x7)
+;;     ((q+:qt.key_5) #x8)
+;;     ((q+:qt.key_6) #x9)
+;;     ((q+:qt.key_enter) #xE)
 
-    ((q+:qt.key_1) #xA)
-    ((q+:qt.key_2) #x0)
-    ((q+:qt.key_3) #xB)
-    ((q+:qt.key_0) #xF)))
+;;     ((q+:qt.key_1) #xA)
+;;     ((q+:qt.key_2) #x0)
+;;     ((q+:qt.key_3) #xB)
+;;     ((q+:qt.key_0) #xF)))
 
-;; (defun pad-key-for (code)
-;;   ;; Original Chip-8 Pad → Laptop
-;;   ;; ┌─┬─┬─┬─┐             ┌─┬─┬─┬─┐
-;;   ;; │1│2│3│C│             │1│2│3│4│
-;;   ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
-;;   ;; │4│5│6│D│             │Q│W│E│R│
-;;   ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
-;;   ;; │7│8│9│E│             │A│S│D│F│
-;;   ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
-;;   ;; │A│0│B│F│             │Z│X│C│V│
-;;   ;; └─┴─┴─┴─┘             └─┴─┴─┴─┘
-;;   ;;
-;;   (qtenumcase code
-;;     ((q+:qt.key_1) #x1)
-;;     ((q+:qt.key_2) #x2)
-;;     ((q+:qt.key_3) #x3)
-;;     ((q+:qt.key_4) #xC)
+(defun pad-key-for (code)
+  ;; Original Chip-8 Pad → Laptop
+  ;; ┌─┬─┬─┬─┐             ┌─┬─┬─┬─┐
+  ;; │1│2│3│C│             │1│2│3│4│
+  ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
+  ;; │4│5│6│D│             │Q│W│E│R│
+  ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
+  ;; │7│8│9│E│             │A│S│D│F│
+  ;; ├─┼─┼─┼─┤             ├─┼─┼─┼─┤
+  ;; │A│0│B│F│             │Z│X│C│V│
+  ;; └─┴─┴─┴─┘             └─┴─┴─┴─┘
+  ;;
+  (qtenumcase code
+    ((q+:qt.key_1) #x1)
+    ((q+:qt.key_2) #x2)
+    ((q+:qt.key_3) #x3)
+    ((q+:qt.key_4) #xC)
 
-;;     ((q+:qt.key_q) #x4)
-;;     ((q+:qt.key_w) #x5)
-;;     ((q+:qt.key_e) #x6)
-;;     ((q+:qt.key_r) #xD)
+    ((q+:qt.key_q) #x4)
+    ((q+:qt.key_w) #x5)
+    ((q+:qt.key_e) #x6)
+    ((q+:qt.key_r) #xD)
 
-;;     ((q+:qt.key_a) #x7)
-;;     ((q+:qt.key_s) #x8)
-;;     ((q+:qt.key_d) #x9)
-;;     ((q+:qt.key_f) #xE)
+    ((q+:qt.key_a) #x7)
+    ((q+:qt.key_s) #x8)
+    ((q+:qt.key_d) #x9)
+    ((q+:qt.key_f) #xE)
 
-;;     ((q+:qt.key_z) #xA)
-;;     ((q+:qt.key_x) #x0)
-;;     ((q+:qt.key_c) #xB)
-;;     ((q+:qt.key_v) #xF)))
+    ((q+:qt.key_z) #xA)
+    ((q+:qt.key_x) #x0)
+    ((q+:qt.key_c) #xB)
+    ((q+:qt.key_v) #xF)))
 
 
 (define-override (screen key-press-event) (ev)
@@ -231,7 +231,7 @@
                 window
                 "Load ROM"
                 (uiop:native-namestring (asdf:system-source-directory :cl-chip8))
-                "ROM Files (*.rom);;All Files (*)")))
+                "ROM Files (*.rom);;CH8 Files (*.ch8);;All Files (*)")))
     (if (string= path "")
       nil
       path)))
diff -r 205427feb9fe -r 1f56f1f1a43d vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,21 +0,0 @@
-(ql:quickload 'quickutil)
-
-(qtlc:save-utils-as
-  "quickutils.lisp"
-  :utilities '(
-
-               :compose
-               :curry
-               :ensure-boolean
-               :ensure-gethash
-               :ensure-list
-               :once-only
-               :rcurry
-               :read-file-into-byte-vector
-               :removef
-               :symb
-               :with-gensyms
-               :xor
-
-               )
-  :package "CHIP8.QUICKUTILS")
diff -r 205427feb9fe -r 1f56f1f1a43d vendor/quickutils-package.lisp
--- a/vendor/quickutils-package.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,12 +0,0 @@
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (unless (find-package "CHIP8.QUICKUTILS")
-    (defpackage "CHIP8.QUICKUTILS"
-      (:documentation "Package that contains Quickutil utility functions.")
-      (:use :cl))))
-
-(in-package "CHIP8.QUICKUTILS")
-
-;; need to define this here so sbcl will shut the hell up about it being
-;; undefined when compiling quickutils.lisp.  computers are trash.
-(defparameter *utilities* nil)
-
diff -r 205427feb9fe -r 1f56f1f1a43d vendor/quickutils.lisp
--- a/vendor/quickutils.lisp	Sun Aug 06 20:29:52 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,309 +0,0 @@
-;;;; This file was automatically generated by Quickutil.
-;;;; See http://quickutil.org for details.
-
-;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :ONCE-ONLY :RCURRY :READ-FILE-INTO-BYTE-VECTOR :REMOVEF :SYMB :WITH-GENSYMS :XOR) :ensure-package T :package "CHIP8.QUICKUTILS")
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (unless (find-package "CHIP8.QUICKUTILS")
-    (defpackage "CHIP8.QUICKUTILS"
-      (:documentation "Package that contains Quickutil utility functions.")
-      (:use #:cl))))
-
-(in-package "CHIP8.QUICKUTILS")
-
-(when (boundp '*utilities*)
-  (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
-                                         :COMPOSE :CURRY :ENSURE-BOOLEAN
-                                         :ENSURE-GETHASH :ENSURE-LIST
-                                         :ONCE-ONLY :RCURRY :WITH-OPEN-FILE*
-                                         :WITH-INPUT-FROM-FILE
-                                         :READ-FILE-INTO-BYTE-VECTOR :REMOVEF
-                                         :MKSTR :SYMB :STRING-DESIGNATOR
-                                         :WITH-GENSYMS :XOR))))
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun make-gensym-list (length &optional (x "G"))
-    "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
-using the second (optional, defaulting to `\"G\"`) argument."
-    (let ((g (if (typep x '(integer 0)) x (string x))))
-      (loop repeat length
-            collect (gensym g))))
-  )                                        ; eval-when
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  ;;; To propagate return type and allow the compiler to eliminate the IF when
-  ;;; it is known if the argument is function or not.
-  (declaim (inline ensure-function))
-
-  (declaim (ftype (function (t) (values function &optional))
-                  ensure-function))
-  (defun ensure-function (function-designator)
-    "Returns the function designated by `function-designator`:
-if `function-designator` is a function, it is returned, otherwise
-it must be a function name and its `fdefinition` is returned."
-    (if (functionp function-designator)
-        function-designator
-        (fdefinition function-designator)))
-  )                                        ; eval-when
-
-  (defun compose (function &rest more-functions)
-    "Returns a function composed of `function` and `more-functions` that applies its ;
-arguments to to each in turn, starting from the rightmost of `more-functions`,
-and then calling the next one with the primary value of the last."
-    (declare (optimize (speed 3) (safety 1) (debug 1)))
-    (reduce (lambda (f g)
-              (let ((f (ensure-function f))
-                    (g (ensure-function g)))
-                (lambda (&rest arguments)
-                  (declare (dynamic-extent arguments))
-                  (funcall f (apply g arguments)))))
-            more-functions
-            :initial-value function))
-
-  (define-compiler-macro compose (function &rest more-functions)
-    (labels ((compose-1 (funs)
-               (if (cdr funs)
-                   `(funcall ,(car funs) ,(compose-1 (cdr funs)))
-                   `(apply ,(car funs) arguments))))
-      (let* ((args (cons function more-functions))
-             (funs (make-gensym-list (length args) "COMPOSE")))
-        `(let ,(loop for f in funs for arg in args
-                     collect `(,f (ensure-function ,arg)))
-           (declare (optimize (speed 3) (safety 1) (debug 1)))
-           (lambda (&rest arguments)
-             (declare (dynamic-extent arguments))
-             ,(compose-1 funs))))))
-  
-
-  (defun curry (function &rest arguments)
-    "Returns a function that applies `arguments` and the arguments
-it is called with to `function`."
-    (declare (optimize (speed 3) (safety 1) (debug 1)))
-    (let ((fn (ensure-function function)))
-      (lambda (&rest more)
-        (declare (dynamic-extent more))
-        ;; Using M-V-C we don't need to append the arguments.
-        (multiple-value-call fn (values-list arguments) (values-list more)))))
-
-  (define-compiler-macro curry (function &rest arguments)
-    (let ((curries (make-gensym-list (length arguments) "CURRY"))
-          (fun (gensym "FUN")))
-      `(let ((,fun (ensure-function ,function))
-             ,@(mapcar #'list curries arguments))
-         (declare (optimize (speed 3) (safety 1) (debug 1)))
-         (lambda (&rest more)
-           (apply ,fun ,@curries more)))))
-  
-
-  (defun ensure-boolean (x)
-    "Convert `x` into a Boolean value."
-    (and x t))
-  
-
-  (defmacro ensure-gethash (key hash-table &optional default)
-    "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
-under key before returning it. Secondary return value is true if key was
-already in the table."
-    `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
-       (if ok
-           (values value ok)
-           (values (setf (gethash ,key ,hash-table) ,default) nil))))
-  
-
-  (defun ensure-list (list)
-    "If `list` is a list, it is returned. Otherwise returns the list designated by `list`."
-    (if (listp list)
-        list
-        (list list)))
-  
-
-  (defmacro once-only (specs &body forms)
-    "Evaluates `forms` with symbols specified in `specs` rebound to temporary
-variables, ensuring that each initform is evaluated only once.
-
-Each of `specs` must either be a symbol naming the variable to be rebound, or of
-the form:
-
-    (symbol initform)
-
-Bare symbols in `specs` are equivalent to
-
-    (symbol symbol)
-
-Example:
-
-    (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
-      (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
-    (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
-          (names-and-forms (mapcar (lambda (spec)
-                                     (etypecase spec
-                                       (list
-                                        (destructuring-bind (name form) spec
-                                          (cons name form)))
-                                       (symbol
-                                        (cons spec spec))))
-                                   specs)))
-      ;; bind in user-macro
-      `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
-              gensyms names-and-forms)
-         ;; bind in final expansion
-         `(let (,,@(mapcar (lambda (g n)
-                             ``(,,g ,,(cdr n)))
-                           gensyms names-and-forms))
-            ;; bind in user-macro
-            ,(let ,(mapcar (lambda (n g) (list (car n) g))
-                    names-and-forms gensyms)
-               ,@forms)))))
-  
-
-  (defun rcurry (function &rest arguments)
-    "Returns a function that applies the arguments it is called
-with and `arguments` to `function`."
-    (declare (optimize (speed 3) (safety 1) (debug 1)))
-    (let ((fn (ensure-function function)))
-      (lambda (&rest more)
-        (declare (dynamic-extent more))
-        (multiple-value-call fn (values-list more) (values-list arguments)))))
-  
-
-  (defmacro with-open-file* ((stream filespec &key direction element-type
-                                                   if-exists if-does-not-exist external-format)
-                             &body body)
-    "Just like `with-open-file`, but `nil` values in the keyword arguments mean to use
-the default value specified for `open`."
-    (once-only (direction element-type if-exists if-does-not-exist external-format)
-      `(with-open-stream
-           (,stream (apply #'open ,filespec
-                           (append
-                            (when ,direction
-                              (list :direction ,direction))
-                            (when ,element-type
-                              (list :element-type ,element-type))
-                            (when ,if-exists
-                              (list :if-exists ,if-exists))
-                            (when ,if-does-not-exist
-                              (list :if-does-not-exist ,if-does-not-exist))
-                            (when ,external-format
-                              (list :external-format ,external-format)))))
-         ,@body)))
-  
-
-  (defmacro with-input-from-file ((stream-name file-name &rest args
-                                                         &key (direction nil direction-p)
-                                                         &allow-other-keys)
-                                  &body body)
-    "Evaluate `body` with `stream-name` to an input stream on the file
-`file-name`. `args` is sent as is to the call to `open` except `external-format`,
-which is only sent to `with-open-file` when it's not `nil`."
-    (declare (ignore direction))
-    (when direction-p
-      (error "Can't specifiy :DIRECTION for WITH-INPUT-FROM-FILE."))
-    `(with-open-file* (,stream-name ,file-name :direction :input ,@args)
-       ,@body))
-  
-
-  (defun read-file-into-byte-vector (pathname)
-    "Read `pathname` into a freshly allocated `(unsigned-byte 8)` vector."
-    (with-input-from-file (stream pathname :element-type '(unsigned-byte 8))
-      (let ((length (file-length stream)))
-        (assert length)
-        (let ((result (make-array length :element-type '(unsigned-byte 8))))
-          (read-sequence result stream)
-          result))))
-  
-
-  (declaim (inline remove/swapped-arguments))
-  (defun remove/swapped-arguments (sequence item &rest keyword-arguments)
-    (apply #'remove item sequence keyword-arguments))
-
-  (define-modify-macro removef (item &rest remove-keywords)
-    remove/swapped-arguments
-    "Modify-macro for `remove`. Sets place designated by the first argument to
-the result of calling `remove` with `item`, place, and the `keyword-arguments`.")
-  
-
-  (defun mkstr (&rest args)
-    "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
-
-Extracted from _On Lisp_, chapter 4."
-    (with-output-to-string (s)
-      (dolist (a args) (princ a s))))
-  
-
-  (defun symb (&rest args)
-    "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol.
-
-Extracted from _On Lisp_, chapter 4.
-
-See also: `symbolicate`"
-    (values (intern (apply #'mkstr args))))
-  
-
-  (deftype string-designator ()
-    "A string designator type. A string designator is either a string, a symbol,
-or a character."
-    `(or symbol string character))
-  
-
-  (defmacro with-gensyms (names &body forms)
-    "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
-    (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
-    (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
-    `(let ,(mapcar (lambda (name)
-                     (multiple-value-bind (symbol string)
-                         (etypecase name
-                           (symbol
-                            (values name (symbol-name name)))
-                           ((cons symbol (cons string-designator null))
-                            (values (first name) (string (second name)))))
-                       `(,symbol (gensym ,string))))
-            names)
-       ,@forms))
-
-  (defmacro with-unique-names (names &body forms)
-    "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
-    (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
-    (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
-    `(with-gensyms ,names ,@forms))
-  
-
-  (defmacro xor (&rest datums)
-    "Evaluates its arguments one at a time, from left to right. If more then one
-argument evaluates to a true value no further `datums` are evaluated, and `nil` is
-returned as both primary and secondary value. If exactly one argument
-evaluates to true, its value is returned as the primary value after all the
-arguments have been evaluated, and `t` is returned as the secondary value. If no
-arguments evaluate to true `nil` is retuned as primary, and `t` as secondary
-value."
-    (with-gensyms (xor tmp true)
-      `(let (,tmp ,true)
-         (block ,xor
-           ,@(mapcar (lambda (datum)
-                       `(if (setf ,tmp ,datum)
-                            (if ,true
-                                (return-from ,xor (values nil nil))
-                                (setf ,true ,tmp))))
-                     datums)
-           (return-from ,xor (values ,true t))))))
-  
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose curry ensure-boolean ensure-gethash ensure-list once-only
-            rcurry read-file-into-byte-vector removef symb with-gensyms
-            with-unique-names xor)))
-
-;;;; END OF quickutils.lisp ;;;;