# HG changeset patch # User Steve Losh # Date 1543695111 18000 # Node ID bc917916aa2bc9e5ece91799c19fcf19415fffc3 # Parent 1329a18951050fb1a8fa4e51f269779c765f549e Start another year. diff -r 1329a1895105 -r bc917916aa2b LICENSE.markdown --- 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 diff -r 1329a1895105 -r bc917916aa2b README.markdown --- 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 diff -r 1329a1895105 -r bc917916aa2b advent.asd --- 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"))))))) diff -r 1329a1895105 -r bc917916aa2b package.lisp --- 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)) diff -r 1329a1895105 -r bc917916aa2b src/2017/main.lisp --- /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)))))))) diff -r 1329a1895105 -r bc917916aa2b src/2017/number-spiral.lisp --- /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)))) diff -r 1329a1895105 -r bc917916aa2b src/2018/main.lisp --- /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))))) diff -r 1329a1895105 -r bc917916aa2b src/main.lisp --- 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)))))))) diff -r 1329a1895105 -r bc917916aa2b src/number-spiral.lisp --- 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)))) diff -r 1329a1895105 -r bc917916aa2b vendor/make-quickutils.lisp --- 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") diff -r 1329a1895105 -r bc917916aa2b vendor/quickutils.lisp --- 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 ;;;;