# HG changeset patch # User Steve Losh # Date 1661703134 14400 # Node ID b1532457fd8fea6f281faa9141060b56ebbaa973 # Parent 1a47adb89b934a4e242ff485bcdd4031d3a99c91 Update to build diff -r 1a47adb89b93 -r b1532457fd8f Makefile --- 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 diff -r 1a47adb89b93 -r b1532457fd8f antipodes.asd --- 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 diff -r 1a47adb89b93 -r b1532457fd8f build/antipodes.ros --- 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) diff -r 1a47adb89b93 -r b1532457fd8f build/build.lisp --- /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) diff -r 1a47adb89b93 -r b1532457fd8f package.lisp --- 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 diff -r 1a47adb89b93 -r b1532457fd8f src/main.lisp --- 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))) diff -r 1a47adb89b93 -r b1532457fd8f vendor/make-quickutils.lisp --- 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") diff -r 1a47adb89b93 -r b1532457fd8f vendor/quickutils.lisp --- 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 ;;;;