b1532457fd8f default tip

Update to build
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 28 Aug 2022 12:12:14 -0400
parents 1a47adb89b93
children (none)
branches/tags default tip
files Makefile antipodes.asd build/antipodes.ros build/build.lisp package.lisp src/main.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

--- a/Makefile	Sun Jan 08 16:47:41 2017 +0000
+++ b/Makefile	Sun Aug 28 12:12:14 2022 -0400
@@ -1,4 +1,4 @@
-.PHONY: deploy update-deps
+.PHONY: deploy
 
 # Vendor ----------------------------------------------------------------------
 vendor/quickutils.lisp: vendor/make-quickutils.lisp
@@ -10,16 +10,8 @@
 lisps := $(shell ffind '\.(asd|lisp|ros)$$')
 
 build/antipodes: $(lisps)
-	ros build build/antipodes.ros
-
-update-deps:
-	hg -R /home/sjl/cl-losh -v pull -u
-	hg -R /home/sjl/beast -v pull -u
-
-/opt/antipodes/antipodes: update-deps build/antipodes
-	rm -f /opt/antipodes/antipodes
-	cp build/antipodes /opt/antipodes/antipodes
+	sbcl-raw --disable-debugger --load 'build/build.lisp'
+	mv antipodes build/antipodes
 
 deploy: build/antipodes
-	rsync --exclude=build/antipodes --exclude=.hg -avz . silt:/home/sjl/antipodes
-	ssh silt make -C /home/sjl/antipodes /opt/antipodes/antipodes
+	scp build/antipodes jam:/opt/antipodes/antipodes
--- a/antipodes.asd	Sun Jan 08 16:47:41 2017 +0000
+++ b/antipodes.asd	Sun Aug 28 12:12:14 2022 -0400
@@ -8,7 +8,6 @@
 
   :depends-on (:beast
                :black-tie
-               :cl-arrows
                :cl-charms
                :cl-strings
                :iterate
--- a/build/antipodes.ros	Sun Jan 08 16:47:41 2017 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,20 +0,0 @@
-#!/bin/sh
-#|-*- mode:lisp -*-|#
-#|
-exec ros -Q -- $0 "$@"
-|#
-
-
-(unless (find-package :ap)
-  (ql:quickload '(:antipodes) :silent t))
-
-(declaim (optimize (debug 0) (safety 1) (speed 3)))
-
-(let ((*standard-output* (make-broadcast-stream)) ; shut
-      (*error-output* (make-broadcast-stream))) ; up
-  (asdf:load-system 'antipodes :force t))
-
-(defun main (&rest argv)
-  (declare (ignore argv))
-  (ap::main)
-  t)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/build/build.lisp	Sun Aug 28 12:12:14 2022 -0400
@@ -0,0 +1,17 @@
+(unless (find-package :ap)
+  (ql:quickload '(:antipodes)))
+
+(declaim (optimize (debug 1) (safety 1) (speed 3)))
+
+(let ((*standard-output* (make-broadcast-stream)) ; shut
+      (*error-output* (make-broadcast-stream))) ; up
+  (asdf:load-system 'antipodes :force t))
+
+(defun main (&rest argv)
+  (declare (ignore argv))
+  (ap::main))
+
+(sb-ext:save-lisp-and-die "antipodes"
+                          :toplevel 'main
+                          :save-runtime-options t
+                          :executable t)
--- a/package.lisp	Sun Jan 08 16:47:41 2017 +0000
+++ b/package.lisp	Sun Aug 28 12:12:14 2022 -0400
@@ -2,7 +2,6 @@
   (:use
     :cl
     :iterate
-    :cl-arrows
     :losh
     :beast
     :ap.quickutils)
@@ -34,7 +33,6 @@
   (:use
     :cl
     :iterate
-    :cl-arrows
     :losh
     :beast
     :ap.utilities
@@ -99,7 +97,6 @@
   (:use
     :cl
     :iterate
-    :cl-arrows
     :losh
     :ap.utilities
     :ap.quickutils)
@@ -111,7 +108,6 @@
   (:use
     :cl
     :iterate
-    :cl-arrows
     :losh
     :beast
     :ap.entities
--- a/src/main.lisp	Sun Jan 08 16:47:41 2017 +0000
+++ b/src/main.lisp	Sun Aug 28 12:12:14 2022 -0400
@@ -277,9 +277,9 @@
     (let ((items (remove-if-not #'worth? (player/inventory *player*))))
       (popup (format nil "Your possessions were worth ~D points.~2%~{~D - ~A~%~}"
                      (reduce #'+ items :key #'worth/points)
-                     (-<> items
-                       (mapcar (juxt #'worth/points #'holdable/description) <>)
-                       (apply #'append <>)))))))
+                     (_ items
+                       (mapcar (juxt #'worth/points #'holdable/description) _)
+                       (apply #'append _)))))))
 
 
 ;;;; Selection Menu -----------------------------------------------------------
@@ -379,8 +379,8 @@
 (defun render-items (window)
   (let* ((x (coords/x *player*))
          (y (coords/y *player*))
-         (items (-<> (coords-lookup x y)
-                  (remove-if-not #'holdable? <>)))
+         (items (_ (coords-lookup x y)
+                  (remove-if-not #'holdable? _)))
          (here-string (if (underwaterp (aref *terrain* x y))
                         "floating here"
                         "here")))
@@ -516,9 +516,9 @@
 
 
 (defun check-triggers ()
-  (iterate (for trigger :in (-<> *player*
-                              (coords-nearby <> 10)
-                              (remove-if-not #'trigger? <>)))
+  (iterate (for trigger :in (_ *player*
+                              (coords-nearby _ 10)
+                              (remove-if-not #'trigger? _)))
            (popup (trigger/text trigger))
            (destroy-entity trigger)))
 
--- a/vendor/make-quickutils.lisp	Sun Jan 08 16:47:41 2017 +0000
+++ b/vendor/make-quickutils.lisp	Sun Aug 28 12:12:14 2022 -0400
@@ -4,17 +4,10 @@
   "quickutils.lisp"
   :utilities '(
 
-               :compose
-               :curry
                :define-constant
                :deletef
-               :mkstr
-               :once-only
-               :rcurry
                :read-file-into-string
                :removef
-               :symb
-               :with-gensyms
 
                )
   :package "AP.QUICKUTILS")
--- a/vendor/quickutils.lisp	Sun Jan 08 16:47:41 2017 +0000
+++ b/vendor/quickutils.lisp	Sun Aug 28 12:12:14 2022 -0400
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :DELETEF :MKSTR :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :REMOVEF :SYMB :WITH-GENSYMS) :ensure-package T :package "AP.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :DELETEF :READ-FILE-INTO-STRING :REMOVEF) :ensure-package T :package "AP.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "AP.QUICKUTILS")
@@ -13,84 +13,9 @@
 (in-package "AP.QUICKUTILS")
 
 (when (boundp '*utilities*)
-  (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
-                                         :COMPOSE :CURRY :DEFINE-CONSTANT
-                                         :DELETEF :MKSTR :ONCE-ONLY :RCURRY
+  (setf *utilities* (union *utilities* '(:DEFINE-CONSTANT :DELETEF :MAKE-GENSYM-LIST :ONCE-ONLY
                                          :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
-                                         :READ-FILE-INTO-STRING :REMOVEF :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 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)))))
-  
+                                         :READ-FILE-INTO-STRING :REMOVEF))))
 
   (defun %reevaluate-constant (name value test)
     (if (not (boundp name))
@@ -138,14 +63,14 @@
     "Modify-macro for `delete`. Sets place designated by the first argument to
 the result of calling `delete` 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))))
-  
+(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
 
   (defmacro once-only (specs &body forms)
     "Evaluates `forms` with symbols specified in `specs` rebound to temporary
@@ -186,16 +111,6 @@
                ,@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)
@@ -257,61 +172,7 @@
     "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 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 '(compose curry define-constant deletef mkstr once-only rcurry
-            read-file-into-string removef symb with-gensyms with-unique-names)))
+  (export '(define-constant deletef read-file-into-string removef)))
 
 ;;;; END OF quickutils.lisp ;;;;