--- a/LICENSE.markdown Wed Dec 06 18:44:23 2017 -0500
+++ b/LICENSE.markdown Sat Dec 01 15:11:51 2018 -0500
@@ -1,4 +1,4 @@
-Copyright (c) 2017 Steve Losh and contributors
+Copyright (c) 2018 Steve Losh and contributors
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
--- a/README.markdown Wed Dec 06 18:44:23 2017 -0500
+++ b/README.markdown Sat Dec 01 15:11:51 2018 -0500
@@ -1,3 +1,3 @@
-Solutions to http://adventofcode.com/ in Common Lisp (SBCL).
+Solutions to http://adventofcode.com/ in Common Lisp.
License: MIT/X11
--- a/advent.asd Wed Dec 06 18:44:23 2017 -0500
+++ b/advent.asd Sat Dec 01 15:11:51 2018 -0500
@@ -13,5 +13,5 @@
(:file "quickutils")))
(:file "package")
(:module "src" :serial t
- :components ((:file "number-spiral")
- (:file "main")))))
+ :components ((:module "2018" :serial t
+ :components ((:file "main")))))))
--- a/package.lisp Wed Dec 06 18:44:23 2017 -0500
+++ b/package.lisp Sat Dec 01 15:11:51 2018 -0500
@@ -1,6 +1,3 @@
(defpackage :advent
(:use :cl :losh :iterate :advent.quickutils))
-(defpackage :advent.spiral
- (:use :cl :losh :iterate :advent.quickutils)
- (:export :number-coordinates))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/main.lisp Sat Dec 01 15:11:51 2018 -0500
@@ -0,0 +1,157 @@
+(in-package :advent)
+
+;;;; Utils --------------------------------------------------------------------
+(defun read-file-of-digits (path)
+ "Read all the ASCII digits in `path` into a list of integers.
+
+ Any character in the file that's not an ASCII digit will be silently ignored.
+
+ "
+ (-<> path
+ read-file-into-string
+ (map 'list #'digit-char-p <>)
+ (remove nil <>)))
+
+(defun read-file-of-numbers (path)
+ (iterate (for line :in-file path :using #'read-line)
+ (appending (mapcar #'parse-integer (str:words line)))))
+
+(defun read-file-of-lines-of-numbers (path)
+ (iterate (for line :in-file path :using #'read-line)
+ (collect (mapcar #'parse-integer (str:words line)))))
+
+(defun read-file-of-lines-of-words (path)
+ (iterate (for line :in-file path :using #'read-line)
+ (collect (str:words line))))
+
+
+;;;; Problems -----------------------------------------------------------------
+(defun day-1/1 ()
+ (iterate (for (x . y) :pairs-of-list (read-file-of-digits "data/2017/01"))
+ (when (= x y)
+ (sum x))))
+
+(defun day-1/2 ()
+ (iterate
+ (with data = (coerce (read-file-of-digits "data/2017/01") 'vector))
+ (with length = (length data))
+ (for x :in-vector data)
+ (for iy :modulo length :from (truncate length 2))
+ (for y = (aref data iy))
+ (when (= x y)
+ (sum x))))
+
+
+(defun day-2/1 ()
+ (flet ((checksum (line)
+ (- (apply #'max line)
+ (apply #'min line))))
+ (summation (remove nil (read-file-of-lines-of-numbers "data/2017/02"))
+ :key #'checksum)))
+
+(defun day-2/2 ()
+ (labels ((validp (a b)
+ (dividesp (max a b) (min a b)))
+ (head-valid-p (list)
+ (some (curry #'validp (car list))
+ (cdr list)))
+ (checksum (line)
+ (somelist #'head-valid-p line)))
+ (summation (remove nil (read-file-of-lines-of-numbers "data/2017/02"))
+ :key #'checksum)))
+
+
+(defun day-3/1 ()
+ (labels ((manhattan-distance (a b)
+ (+ (abs (- (realpart a)
+ (realpart b)))
+ (abs (- (imagpart a)
+ (imagpart b)))))
+ (distance-to-origin (p)
+ (manhattan-distance #c(0 0) p)))
+ (distance-to-origin (advent.spiral:number-coordinates 325489))))
+
+(defun day-3/2 ()
+ (flet ((neighbors (coord)
+ (iterate (for-nested ((dx :from -1 :to 1)
+ (dy :from -1 :to 1)))
+ (unless (= 0 dx dy)
+ (collect (+ coord (complex dx dy)))))))
+ (iterate
+ (with memory = (make-hash-table))
+ (initially (setf (gethash #c(0 0) memory) 1))
+ (for n :from 2)
+ (for coord = (advent.spiral:number-coordinates n))
+ (for value = (summation (neighbors coord) :key (rcurry #'gethash memory 0)))
+ (finding value :such-that (> value 325489))
+ (setf (gethash coord memory) value))))
+
+
+(defun day-4/1 ()
+ (labels ((contains-duplicates-p (list &key (test #'eql))
+ (iterate (for (head . tail) :on list)
+ (thereis (member head tail :test test))))
+ (validp (phrase)
+ (not (contains-duplicates-p phrase :test #'string=))))
+ (count-if #'validp (read-file-of-lines-of-words "data/2017/04"))))
+
+(defun day-4/2 ()
+ (labels ((anagramp (string1 string2)
+ (string= (sort (copy-seq string1) #'char<)
+ (sort (copy-seq string2) #'char<)))
+ (contains-anagram-p (phrase)
+ (iterate (for (word . tail) :on phrase)
+ (thereis (member-if (curry #'anagramp word) tail)))))
+ (count-if-not #'contains-anagram-p
+ (read-file-of-lines-of-words "data/2017/04"))))
+
+
+(defun day-5/1 ()
+ (iterate
+ (with maze = (coerce (read-file-of-numbers "data/2017/05") 'vector))
+ (with bound = (1- (length maze)))
+ (with address = 0)
+ (for steps :from 0)
+ (finding steps :such-that (not (<= 0 address bound)))
+ (for offset = (aref maze address))
+ (incf (aref maze address))
+ (incf address offset)))
+
+(defun day-5/2 ()
+ (iterate
+ (declare (optimize speed)
+ (type fixnum bound address steps offset))
+ (with maze = (coerce (read-file-of-numbers "data/2017/05") 'simple-vector))
+ (with bound = (1- (length maze)))
+ (with address = 0)
+ (for steps :from 0)
+ (finding steps :such-that (not (<= 0 address bound)))
+ (for offset = (aref maze address))
+ (incf (aref maze address)
+ (if (>= offset 3) -1 1))
+ (incf address offset)))
+
+
+(defun day-6/1+2 ()
+ (let* ((banks (coerce (read-file-of-numbers "data/2017/06") 'vector))
+ (seen (make-hash-table :test 'equalp)))
+ (labels ((bank-to-redistribute ()
+ (iterate (for blocks :in-vector banks :with-index bank)
+ (finding bank :maximizing blocks)))
+ (redistribute ()
+ (iterate
+ (with bank = (bank-to-redistribute))
+ (with blocks-to-redistribute = (aref banks bank))
+ (initially (setf (aref banks bank) 0))
+ (repeat blocks-to-redistribute)
+ (for b :modulo (length banks) :from (1+ bank))
+ (incf (aref banks b))))
+ (mark-seen (banks cycles)
+ (setf (gethash (copy-seq banks) seen) cycles)))
+ (iterate
+ (mark-seen banks cycles)
+ (summing 1 :into cycles)
+ (redistribute)
+ (for last-seen = (gethash banks seen))
+ (until last-seen)
+ (finally (return (values cycles (- cycles last-seen))))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/number-spiral.lisp Sat Dec 01 15:11:51 2018 -0500
@@ -0,0 +1,90 @@
+(defpackage :advent.spiral
+ (:use :cl :losh :iterate :advent.quickutils)
+ (:export :number-coordinates))
+
+(in-package :advent.spiral)
+
+(defun layer-side-length (layer)
+ "Return the length of one side of `layer`."
+ (1+ (* 2 layer)))
+
+(defun layer-size (layer)
+ "Return the total size of a number spiral with a final layer of `layer`."
+ (square (layer-side-length layer)))
+
+(defun layer-for-number (number)
+ "Return the index of the layer containing `number`."
+ (ceiling (/ (1- (sqrt number)) 2)))
+
+(defun layer-start (layer)
+ "Return the smallest number in `layer`."
+ (if (zerop layer)
+ 1
+ (1+ (layer-size (1- layer)))))
+
+(defun layer-leg-length (layer)
+ "Return the length of one \"leg\" of `layer`."
+ (1- (layer-side-length layer)))
+
+
+(defun leg (layer number)
+ "Return the leg index and offset of `number` in `layer`."
+ (if (= 1 number)
+ (values 0 0)
+ (let ((idx (- number (layer-start layer)))
+ (legsize (layer-leg-length layer)))
+ (values (floor idx legsize)
+ (1+ (mod idx legsize))))))
+
+(defun corner-coordinates (layer leg)
+ "Return the coordinates of the corner starting `leg` in `layer`.
+
+ Leg | Corner
+ 0 | Bottom Right
+ 1 | Top Right
+ 2 | Top Left
+ 3 | Bottom Left
+
+ "
+
+ ;; 2 1
+ ;;
+ ;; 3 0
+ (ccase leg
+ (0 (complex layer (- layer)))
+ (1 (complex layer layer))
+ (2 (complex (- layer) layer))
+ (3 (complex (- layer) (- layer)))))
+
+(defun leg-direction (leg)
+ "Return the direction vector for the given `leg`.
+ "
+ ;; <--
+ ;; 11110
+ ;; | 2 0 ^
+ ;; | 2 0 |
+ ;; v 2 0 |
+ ;; 23333
+ ;; -->
+ (ccase leg
+ (0 (complex 0 1))
+ (1 (complex -1 0))
+ (2 (complex 0 -1))
+ (3 (complex 1 0))))
+
+
+(defun number-coordinates (number)
+ (nest
+ ;; Find the layer the number falls in.
+ (let ((layer (layer-for-number number))))
+
+ ;; Find which leg of that layer it's in, and how far along the leg it is.
+ (multiple-value-bind (leg offset) (leg layer number))
+
+ ;; Find the coordinates of the leg's corner, and its direction vector.
+ (let ((corner (corner-coordinates layer leg))
+ (direction (leg-direction leg))))
+
+ ;; Start at the corner and add the offset in the leg's direction to find the
+ ;; number's coordinates.
+ (+ corner (* direction offset))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/main.lisp Sat Dec 01 15:11:51 2018 -0500
@@ -0,0 +1,22 @@
+(in-package :advent)
+
+;;;; Utils --------------------------------------------------------------------
+(defmacro define-problem ((day part) (data-symbol reader) &body body)
+ (let ((function-name (symb 'day- day '/ part)))
+ `(defun ,function-name ()
+ (let ((,data-symbol (,reader ,(format nil "data/2018/~2,'0D.txt" day))))
+ ,@body))))
+
+;;;; Problems -----------------------------------------------------------------
+(define-problem (1 1) (data read-all-from-file)
+ (reduce #'+ data))
+
+(define-problem (1 2) (data read-all-from-file)
+ (let ((seen (make-hash-set :initial-contents '(0)))
+ (frequency 0))
+ (setf (cdr (last data)) data) ; make data a circular list for easy repetition
+ (dolist (number data)
+ (incf frequency number)
+ (if (hset-contains-p seen frequency)
+ (return frequency)
+ (hset-insert! seen frequency)))))
--- a/src/main.lisp Wed Dec 06 18:44:23 2017 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,157 +0,0 @@
-(in-package :advent)
-
-;;;; Utils --------------------------------------------------------------------
-(defun read-file-of-digits (path)
- "Read all the ASCII digits in `path` into a list of integers.
-
- Any character in the file that's not an ASCII digit will be silently ignored.
-
- "
- (-<> path
- read-file-into-string
- (map 'list #'digit-char-p <>)
- (remove nil <>)))
-
-(defun read-file-of-numbers (path)
- (iterate (for line :in-file path :using #'read-line)
- (appending (mapcar #'parse-integer (str:words line)))))
-
-(defun read-file-of-lines-of-numbers (path)
- (iterate (for line :in-file path :using #'read-line)
- (collect (mapcar #'parse-integer (str:words line)))))
-
-(defun read-file-of-lines-of-words (path)
- (iterate (for line :in-file path :using #'read-line)
- (collect (str:words line))))
-
-
-;;;; Problems -----------------------------------------------------------------
-(defun day-1/1 ()
- (iterate (for (x . y) :pairs-of-list (read-file-of-digits "data/2017/01"))
- (when (= x y)
- (sum x))))
-
-(defun day-1/2 ()
- (iterate
- (with data = (coerce (read-file-of-digits "data/2017/01") 'vector))
- (with length = (length data))
- (for x :in-vector data)
- (for iy :modulo length :from (truncate length 2))
- (for y = (aref data iy))
- (when (= x y)
- (sum x))))
-
-
-(defun day-2/1 ()
- (flet ((checksum (line)
- (- (apply #'max line)
- (apply #'min line))))
- (summation (remove nil (read-file-of-lines-of-numbers "data/2017/02"))
- :key #'checksum)))
-
-(defun day-2/2 ()
- (labels ((validp (a b)
- (dividesp (max a b) (min a b)))
- (head-valid-p (list)
- (some (curry #'validp (car list))
- (cdr list)))
- (checksum (line)
- (somelist #'head-valid-p line)))
- (summation (remove nil (read-file-of-lines-of-numbers "data/2017/02"))
- :key #'checksum)))
-
-
-(defun day-3/1 ()
- (labels ((manhattan-distance (a b)
- (+ (abs (- (realpart a)
- (realpart b)))
- (abs (- (imagpart a)
- (imagpart b)))))
- (distance-to-origin (p)
- (manhattan-distance #c(0 0) p)))
- (distance-to-origin (advent.spiral:number-coordinates 325489))))
-
-(defun day-3/2 ()
- (flet ((neighbors (coord)
- (iterate (for-nested ((dx :from -1 :to 1)
- (dy :from -1 :to 1)))
- (unless (= 0 dx dy)
- (collect (+ coord (complex dx dy)))))))
- (iterate
- (with memory = (make-hash-table))
- (initially (setf (gethash #c(0 0) memory) 1))
- (for n :from 2)
- (for coord = (advent.spiral:number-coordinates n))
- (for value = (summation (neighbors coord) :key (rcurry #'gethash memory 0)))
- (finding value :such-that (> value 325489))
- (setf (gethash coord memory) value))))
-
-
-(defun day-4/1 ()
- (labels ((contains-duplicates-p (list &key (test #'eql))
- (iterate (for (head . tail) :on list)
- (thereis (member head tail :test test))))
- (validp (phrase)
- (not (contains-duplicates-p phrase :test #'string=))))
- (count-if #'validp (read-file-of-lines-of-words "data/2017/04"))))
-
-(defun day-4/2 ()
- (labels ((anagramp (string1 string2)
- (string= (sort (copy-seq string1) #'char<)
- (sort (copy-seq string2) #'char<)))
- (contains-anagram-p (phrase)
- (iterate (for (word . tail) :on phrase)
- (thereis (member-if (curry #'anagramp word) tail)))))
- (count-if-not #'contains-anagram-p
- (read-file-of-lines-of-words "data/2017/04"))))
-
-
-(defun day-5/1 ()
- (iterate
- (with maze = (coerce (read-file-of-numbers "data/2017/05") 'vector))
- (with bound = (1- (length maze)))
- (with address = 0)
- (for steps :from 0)
- (finding steps :such-that (not (<= 0 address bound)))
- (for offset = (aref maze address))
- (incf (aref maze address))
- (incf address offset)))
-
-(defun day-5/2 ()
- (iterate
- (declare (optimize speed)
- (type fixnum bound address steps offset))
- (with maze = (coerce (read-file-of-numbers "data/2017/05") 'simple-vector))
- (with bound = (1- (length maze)))
- (with address = 0)
- (for steps :from 0)
- (finding steps :such-that (not (<= 0 address bound)))
- (for offset = (aref maze address))
- (incf (aref maze address)
- (if (>= offset 3) -1 1))
- (incf address offset)))
-
-
-(defun day-6/1+2 ()
- (let* ((banks (coerce (read-file-of-numbers "data/2017/06") 'vector))
- (seen (make-hash-table :test 'equalp)))
- (labels ((bank-to-redistribute ()
- (iterate (for blocks :in-vector banks :with-index bank)
- (finding bank :maximizing blocks)))
- (redistribute ()
- (iterate
- (with bank = (bank-to-redistribute))
- (with blocks-to-redistribute = (aref banks bank))
- (initially (setf (aref banks bank) 0))
- (repeat blocks-to-redistribute)
- (for b :modulo (length banks) :from (1+ bank))
- (incf (aref banks b))))
- (mark-seen (banks cycles)
- (setf (gethash (copy-seq banks) seen) cycles)))
- (iterate
- (mark-seen banks cycles)
- (summing 1 :into cycles)
- (redistribute)
- (for last-seen = (gethash banks seen))
- (until last-seen)
- (finally (return (values cycles (- cycles last-seen))))))))
--- a/src/number-spiral.lisp Wed Dec 06 18:44:23 2017 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,86 +0,0 @@
-(in-package :advent.spiral)
-
-(defun layer-side-length (layer)
- "Return the length of one side of `layer`."
- (1+ (* 2 layer)))
-
-(defun layer-size (layer)
- "Return the total size of a number spiral with a final layer of `layer`."
- (square (layer-side-length layer)))
-
-(defun layer-for-number (number)
- "Return the index of the layer containing `number`."
- (ceiling (/ (1- (sqrt number)) 2)))
-
-(defun layer-start (layer)
- "Return the smallest number in `layer`."
- (if (zerop layer)
- 1
- (1+ (layer-size (1- layer)))))
-
-(defun layer-leg-length (layer)
- "Return the length of one \"leg\" of `layer`."
- (1- (layer-side-length layer)))
-
-
-(defun leg (layer number)
- "Return the leg index and offset of `number` in `layer`."
- (if (= 1 number)
- (values 0 0)
- (let ((idx (- number (layer-start layer)))
- (legsize (layer-leg-length layer)))
- (values (floor idx legsize)
- (1+ (mod idx legsize))))))
-
-(defun corner-coordinates (layer leg)
- "Return the coordinates of the corner starting `leg` in `layer`.
-
- Leg | Corner
- 0 | Bottom Right
- 1 | Top Right
- 2 | Top Left
- 3 | Bottom Left
-
- "
-
- ;; 2 1
- ;;
- ;; 3 0
- (ccase leg
- (0 (complex layer (- layer)))
- (1 (complex layer layer))
- (2 (complex (- layer) layer))
- (3 (complex (- layer) (- layer)))))
-
-(defun leg-direction (leg)
- "Return the direction vector for the given `leg`.
- "
- ;; <--
- ;; 11110
- ;; | 2 0 ^
- ;; | 2 0 |
- ;; v 2 0 |
- ;; 23333
- ;; -->
- (ccase leg
- (0 (complex 0 1))
- (1 (complex -1 0))
- (2 (complex 0 -1))
- (3 (complex 1 0))))
-
-
-(defun number-coordinates (number)
- (nest
- ;; Find the layer the number falls in.
- (let ((layer (layer-for-number number))))
-
- ;; Find which leg of that layer it's in, and how far along the leg it is.
- (multiple-value-bind (leg offset) (leg layer number))
-
- ;; Find the coordinates of the leg's corner, and its direction vector.
- (let ((corner (corner-coordinates layer leg))
- (direction (leg-direction leg))))
-
- ;; Start at the corner and add the offset in the leg's direction to find the
- ;; number's coordinates.
- (+ corner (* direction offset))))
--- a/vendor/make-quickutils.lisp Wed Dec 06 18:44:23 2017 -0500
+++ b/vendor/make-quickutils.lisp Sat Dec 01 15:11:51 2018 -0500
@@ -4,12 +4,13 @@
"quickutils.lisp"
:utilities '(
+ :compose
:curry
- :rcurry
+ :ensure-keyword
:range
- :compose
- :ensure-keyword
+ :rcurry
:read-file-into-string
+ :symb
)
:package "ADVENT.QUICKUTILS")
--- a/vendor/quickutils.lisp Wed Dec 06 18:44:23 2017 -0500
+++ b/vendor/quickutils.lisp Sat Dec 01 15:11:51 2018 -0500
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :RCURRY :RANGE :COMPOSE :ENSURE-KEYWORD :READ-FILE-INTO-STRING) :ensure-package T :package "ADVENT.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-KEYWORD :RANGE :RCURRY :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ADVENT.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "ADVENT.QUICKUTILS")
@@ -13,11 +13,7 @@
(in-package "ADVENT.QUICKUTILS")
(when (boundp '*utilities*)
- (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :CURRY :RCURRY :RANGE :COMPOSE
- :ENSURE-KEYWORD :ONCE-ONLY
- :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
- :READ-FILE-INTO-STRING))))
+ (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION :COMPOSE :CURRY :ENSURE-KEYWORD :RANGE :RCURRY :ONCE-ONLY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE :READ-FILE-INTO-STRING :MKSTR :SYMB))))
(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`,
@@ -42,44 +38,6 @@
(fdefinition function-designator)))
) ; eval-when
- (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 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)))))
-
-
- (defun range (start end &key (step 1) (key 'identity))
- "Return the list of numbers `n` such that `start <= n < end` and
-`n = start + k*step` for suitable integers `k`. If a function `key` is
-provided, then apply it to each number."
- (assert (<= start end))
- (loop :for i :from start :below end :by step :collecting (funcall key i)))
-
-
(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`,
@@ -109,11 +67,49 @@
,(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-keyword (x)
"Ensure that a keyword is returned for the string designator `x`."
(values (intern (string x) :keyword)))
+ (defun range (start end &key (step 1) (key 'identity))
+ "Return the list of numbers `n` such that `start <= n < end` and
+`n = start + k*step` for suitable integers `k`. If a function `key` is
+provided, then apply it to each number."
+ (assert (<= start end))
+ (loop :for i :from start :below end :by step :collecting (funcall key i)))
+
+
+ (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 once-only (specs &body forms)
"Evaluates `forms` with symbols specified in `specs` rebound to temporary
variables, ensuring that each initform is evaluated only once.
@@ -204,7 +200,24 @@
:do (write-sequence buffer datum :start 0 :end bytes-read)
:while (= bytes-read buffer-size)))))))
+
+ (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))))
+
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(curry rcurry range compose ensure-keyword read-file-into-string)))
+ (export '(compose curry ensure-keyword range rcurry read-file-into-string symb)))
;;;; END OF quickutils.lisp ;;;;