# HG changeset patch # User Steve Losh # Date 1661705284 14400 # Node ID 4df358dc538b6b02112b723ee8b2bfec6cfba28c # Parent 77c86aa3b4189dda6a662168f48a5086cd3d919b Update to build diff -r 77c86aa3b418 -r 4df358dc538b Makefile --- a/Makefile Wed Mar 27 19:58:04 2019 -0400 +++ b/Makefile Sun Aug 28 12:48:04 2022 -0400 @@ -1,38 +1,12 @@ -.PHONY: vendor binary clean deploy update-deps force-binary - -# Vendor ---------------------------------------------------------------------- -vendor/quickutils.lisp: vendor/make-quickutils.lisp - cd vendor && sbcl --noinform --load make-quickutils.lisp --eval '(quit)' - -vendor: vendor/quickutils.lisp +.PHONY: deploy clean -# Clean ----------------------------------------------------------------------- -clean: - rm -rf bin - -# Build ----------------------------------------------------------------------- -lisps := $(shell ffind '\.(asd|lisp|ros)$$') - -binary: bin/magitek +lisps := $(shell ffind '\.(asd|lisp)$$') -force-binary: - rm -f bin/magitek - sbcl --load "src/build.lisp" - -bin/magitek: $(lisps) - force-binary - -# Deploy ---------------------------------------------------------------------- +bin/magitek: + sbcl --disable-debugger --load 'src/build.lisp' -# Server -update-deps: - hg -R /home/sjl/lib/cl-losh -v pull -u - hg -R /home/sjl/lib/chancery -v pull -u - hg -R /home/sjl/lib/flax -v pull -u - hg -R /home/sjl/lib/cl-pcg -v pull -u +deploy: bin/magitek + rsync -avz bin/ jam:magitek/bin -# Local -deploy: - rsync --exclude=bin --exclude=.hg --exclude=database.sqlite --exclude='*.fasl' --exclude='*.png' --exclude='*.pnm' -avz . jam:/home/sjl/src/magitek - ssh jam make -C /home/sjl/src/magitek update-deps force-binary - +clean: + rm -rf bin/ diff -r 77c86aa3b418 -r 4df358dc538b magitek.asd --- a/magitek.asd Wed Mar 27 19:58:04 2019 -0400 +++ b/magitek.asd Sun Aug 28 12:48:04 2022 -0400 @@ -8,6 +8,7 @@ :depends-on ( + :alexandria :chancery :chirp :fare-quasiquote @@ -30,10 +31,7 @@ :entry-point "magitek:main" :serial t - :components ((:module "vendor" :serial t - :components ((:file "quickutils-package") - (:file "quickutils"))) - (:file "package") + :components ((:file "package") (:module "src" :serial t :components ((:file "readtables") (:file "database") diff -r 77c86aa3b418 -r 4df358dc538b package.lisp --- a/package.lisp Wed Mar 27 19:58:04 2019 -0400 +++ b/package.lisp Sun Aug 28 12:48:04 2022 -0400 @@ -2,8 +2,7 @@ (:use :cl :iterate - :losh - :magitek.quickutils) + :losh) (:export :tt-load-credentials :tt-authorize @@ -14,8 +13,7 @@ (:use :cl :losh - :sqlite - :magitek.quickutils) + :sqlite) (:export :db-connect :db-initialize @@ -27,8 +25,7 @@ (:use :cl :losh - :iterate - :magitek.quickutils) + :iterate) (:export :build-markov-generator :generate-sentence)) @@ -37,8 +34,7 @@ (:use :cl :losh - :iterate - :magitek.quickutils) + :iterate) (:export :generate-heightmap)) @@ -46,40 +42,35 @@ (defpackage :magitek.robots.bit-loom (:use :cl - :losh - :magitek.quickutils) + :losh) (:export :random-tweet)) (defpackage :magitek.robots.git-commands (:use :cl :losh - :chancery - :magitek.quickutils) + :chancery) (:export :random-tweet)) (defpackage :magitek.robots.lisp-talks (:use :cl :losh - :chancery - :magitek.quickutils) + :chancery) (:export :random-tweet)) (defpackage :magitek.robots.rpg-shopkeeper (:use :cl :losh - :chancery - :magitek.quickutils) + :chancery) (:export :random-tweet)) (defpackage :magitek.robots.frantic-barista (:use :cl :losh - :chancery - :magitek.quickutils) + :chancery) (:export :random-tweet)) @@ -89,7 +80,6 @@ :iterate :losh :magitek.twitter - :magitek.database - :magitek.quickutils) + :magitek.database) (:export :main)) diff -r 77c86aa3b418 -r 4df358dc538b src/database.lisp --- a/src/database.lisp Wed Mar 27 19:58:04 2019 -0400 +++ b/src/database.lisp Sun Aug 28 12:48:04 2022 -0400 @@ -34,12 +34,13 @@ (defun db-tweeted-since-p (account minutes-ago) (check-type minutes-ago (integer 1)) (check-db) - (ensure-boolean - (execute-single *database* - "SELECT content FROM tweets + (if (execute-single *database* + "SELECT content FROM tweets WHERE account = ? AND timestamp > datetime('now', ?) LIMIT 1 " - (aesthetic-string account) - (format nil "-~D minutes" minutes-ago)))) + (aesthetic-string account) + (format nil "-~D minutes" minutes-ago)) + t + nil)) diff -r 77c86aa3b418 -r 4df358dc538b src/markov.lisp --- a/src/markov.lisp Wed Mar 27 19:58:04 2019 -0400 +++ b/src/markov.lisp Sun Aug 28 12:48:04 2022 -0400 @@ -16,8 +16,8 @@ (defun markov-insert-pair (markov prefix suffix) (vector-push-extend suffix - (ensure-gethash prefix (markov-database markov) - (make-array 1 :fill-pointer 0 :adjustable t)))) + (alexandria:ensure-gethash prefix (markov-database markov) + (make-array 1 :fill-pointer 0 :adjustable t)))) (defun markov-insert-beginning (markov prefix) (vector-push-extend prefix (markov-beginnings markov))) @@ -93,6 +93,22 @@ (car (last n-gram))) +(defun n-grams (n sequence) + "Find all `n`-grams of the sequence `sequence`." + ;;; From quickutil + (assert (and (plusp n) + (<= n (length sequence)))) + + (etypecase sequence + ;; Lists + (list (loop :repeat (1+ (- (length sequence) n)) + :for seq :on sequence + :collect (take n seq))) + + ;; General sequences + (sequence (loop :for i :to (- (length sequence) n) + :collect (subseq sequence i (+ i n)))))) + (defun chunk-sentence (size sentence) (mapcar (juxt #'prefix #'suffix) (when (>= (length sentence) size) diff -r 77c86aa3b418 -r 4df358dc538b src/robots/rpg-shopkeeper.lisp --- a/src/robots/rpg-shopkeeper.lisp Wed Mar 27 19:58:04 2019 -0400 +++ b/src/robots/rpg-shopkeeper.lisp Sun Aug 28 12:48:04 2022 -0400 @@ -19,7 +19,7 @@ ;;;; Monsters ----------------------------------------------------------------- -(defclass* monster () +(defclass* (monster :conc-name monster-) () (singular multiplier plural adjective)) (defun make-monster (singular multiplier plural adjective) @@ -70,7 +70,7 @@ ;;;; Materials ---------------------------------------------------------------- -(defclass* material () +(defclass* (material :conc-name material-) () (kind name multiplier)) (defun make-material (kind name multiplier) @@ -186,7 +186,7 @@ ;;;; Pieces ------------------------------------------------------------------- -(defclass* piece () +(defclass* (piece :conc-name piece-) () (name base-value)) (defmethod print-object ((o piece) stream) @@ -265,7 +265,7 @@ ;;;; Armor -------------------------------------------------------------------- -(defclass* armor () +(defclass* (armor :conc-name armor-) () (material piece enchantment ornament)) (define-with-macro armor @@ -322,8 +322,8 @@ (defun armor-value (armor) (with-armor (armor) - (* (+ (* (-<> piece piece-base-value) - (-<> material material-multiplier)) + (* (+ (* (_ piece piece-base-value) + (_ material material-multiplier)) (if enchantment 100 0) (if ornament 10 0)) (enchantment-multiplier enchantment) @@ -332,8 +332,8 @@ (defun vanilla-armor-description (vanilla-armor) (format nil "~A ~A" - (-<> vanilla-armor armor-material material-name) - (-<> vanilla-armor armor-piece piece-name))) + (_ vanilla-armor armor-material material-name) + (_ vanilla-armor armor-piece piece-name))) (defun armor-description (armor) @@ -351,7 +351,7 @@ ; ;;;; Weapons ------------------------------------------------------------------ -(defclass* weapon () +(defclass* (weapon :conc-name weapon-) () (material piece enchantment ornament)) (define-with-macro weapon @@ -427,8 +427,8 @@ (defun weapon-value (weapon) (with-weapon (weapon) - (* (+ (* (-<> piece piece-base-value) - (-<> material material-multiplier)) + (* (+ (* (_ piece piece-base-value) + (_ material material-multiplier)) (if enchantment 100 0) (if ornament 10 0)) (enchantment-multiplier enchantment) @@ -438,8 +438,8 @@ (defun vanilla-weapon-description (vanilla-weapon) (with-weapon (vanilla-weapon) (format nil "~A ~A" - (-<> material material-name) - (-<> piece piece-name)))) + (_ material material-name) + (_ piece piece-name)))) (defun weapon-description (weapon) (let ((vanilla-description (vanilla-weapon-description weapon)) @@ -477,9 +477,9 @@ (defun round-to (n sigfigs) (let* ((digits (ceiling (log n 10))) (div (expt 10 (max 0 (- digits sigfigs))))) - (-<> n - (round <> div) - (* <> div)))) + (_ n + (round _ div) + (* _ div)))) (defun sanitize-price (price) (let ((price (round-to price 3))) @@ -490,11 +490,11 @@ (t price)))) (defun item-value (item) - (-<> (etypecase item + (_ (etypecase item (armor (armor-value item)) (weapon (weapon-value item))) - (sanitize-price <>) - (format nil "~:D" <>))) + (sanitize-price _) + (format nil "~:D" _))) (define-string for-the-low-price diff -r 77c86aa3b418 -r 4df358dc538b vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Wed Mar 27 19:58:04 2019 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -(ql:quickload 'quickutil) - -(qtlc:save-utils-as - "quickutils.lisp" - :utilities '( - - :curry - :ensure-boolean - :ensure-gethash - :n-grams - :once-only - :rcurry - :symb - :with-gensyms - - ) - :package "MAGITEK.QUICKUTILS") diff -r 77c86aa3b418 -r 4df358dc538b vendor/quickutils-package.lisp --- a/vendor/quickutils-package.lisp Wed Mar 27 19:58:04 2019 -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 "MAGITEK.QUICKUTILS") - (defpackage "MAGITEK.QUICKUTILS" - (:documentation "Package that contains Quickutil utility functions.") - (:use :cl)))) - -(in-package "MAGITEK.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 77c86aa3b418 -r 4df358dc538b vendor/quickutils.lisp --- a/vendor/quickutils.lisp Wed Mar 27 19:58:04 2019 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,214 +0,0 @@ -;;;; This file was automatically generated by Quickutil. -;;;; See http://quickutil.org for details. - -;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :N-GRAMS :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "MAGITEK.QUICKUTILS") - -(eval-when (:compile-toplevel :load-toplevel :execute) - (unless (find-package "MAGITEK.QUICKUTILS") - (defpackage "MAGITEK.QUICKUTILS" - (:documentation "Package that contains Quickutil utility functions.") - (:use #:cl)))) - -(in-package "MAGITEK.QUICKUTILS") - -(when (boundp '*utilities*) - (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION - :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH - :TAKE :N-GRAMS :ONCE-ONLY :RCURRY - :MKSTR :SYMB :STRING-DESIGNATOR - :WITH-GENSYMS)))) -(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 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 take (n sequence) - "Take the first `n` elements from `sequence`." - (subseq sequence 0 n)) - - - (defun n-grams (n sequence) - "Find all `n`-grams of the sequence `sequence`." - (assert (and (plusp n) - (<= n (length sequence)))) - - (etypecase sequence - ;; Lists - (list (loop :repeat (1+ (- (length sequence) n)) - :for seq :on sequence - :collect (take n seq))) - - ;; General sequences - (sequence (loop :for i :to (- (length sequence) n) - :collect (subseq sequence i (+ i n)))))) - - - (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))))) - - - (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)) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (export '(curry ensure-boolean ensure-gethash n-grams once-only rcurry symb - with-gensyms with-unique-names))) - -;;;; END OF quickutils.lisp ;;;;