4df358dc538b default tip

Update to build
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 28 Aug 2022 12:48:04 -0400
parents 77c86aa3b418
children (none)
branches/tags default tip
files Makefile magitek.asd package.lisp src/database.lisp src/markov.lisp src/robots/rpg-shopkeeper.lisp vendor/make-quickutils.lisp vendor/quickutils-package.lisp vendor/quickutils.lisp

Changes

--- 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/
--- 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")
--- 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))
--- 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))
--- 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)
--- 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
--- 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")
--- 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)
-
--- 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 ;;;;