# HG changeset patch # User Steve Losh # Date 1501902803 14400 # Node ID 61ec616b45f8d1a9c497bcaf4e9202769127252b # Parent 15ab2e1331a15320ce5d114e235340f7800006a8 A few extra functions diff -r 15ab2e1331a1 -r 61ec616b45f8 DOCUMENTATION.markdown --- a/DOCUMENTATION.markdown Tue Jul 04 15:18:11 2017 +0000 +++ b/DOCUMENTATION.markdown Fri Aug 04 23:13:23 2017 -0400 @@ -26,7 +26,7 @@ (BISECT-LEFT PREDICATE VECTOR TARGET) -Bisect `vector` based on `(predicate el target)` and return the LEFT element +Bisect `vector` based on `(predicate el target)` and return the LEFT element. `vector` must be sorted (with `predicate`) before this function is called (this is not checked). @@ -60,7 +60,7 @@ (BISECT-RIGHT PREDICATE VECTOR TARGET) -Bisect `vector` based on `(predicate el target)` and return the RIGHT element +Bisect `vector` based on `(predicate el target)` and return the RIGHT element. `vector` must be sorted (with `predicate`) before this function is called (this is not checked). @@ -158,6 +158,19 @@ +### `VECTOR-LAST` (function) + + (VECTOR-LAST VECTOR) + +Return the last element of `vector`, or `nil` if it is empty. + + A second value is returned, which will be `t` if the vector was not empty and + `nil` if it was. + + The vector's fill-pointer will be respected. + + + ## Package `LOSH.BITS` Utilities for low-level bit stuff. @@ -300,6 +313,43 @@ Thread the given forms, with `<>` as a placeholder. +### `DO-RANGE` (macro) + + (DO-RANGE RANGES + &BODY + BODY) + +Perform `body` on the given `ranges`. + + Each range in `ranges` should be of the form `(variable from below)`. During + iteration `body` will be executed with `variable` bound to successive values + in the range [`from`, `below`). + + If multiple ranges are given they will be iterated in a nested fashion. + + Example: + + (do-range ((x 0 3) + (y 10 12)) + (pr x y)) + ; => + ; 0 10 + ; 0 11 + ; 1 10 + ; 1 11 + ; 2 10 + ; 2 11 + + + +### `DO-REPEAT` (macro) + + (DO-REPEAT N + &BODY + BODY) + +Perform `body` `n` times. + ### `GATHERING` (macro) (GATHERING @@ -373,7 +423,7 @@ ### `IF-FOUND` (macro) - (IF-FOUND VAR LOOKUP-EXPR THEN ELSE) + (IF-FOUND (VAR LOOKUP-EXPR) THEN ELSE) Perform `then` or `else` depending on the results of `lookup-expr`. @@ -395,7 +445,7 @@ ; becomes - (if-found val (gethash :foo hash) + (if-found (val (gethash :foo hash)) 'yes 'no) @@ -424,8 +474,7 @@ ### `WHEN-FOUND` (macro) - (WHEN-FOUND VAR - LOOKUP-EXPR + (WHEN-FOUND (VAR LOOKUP-EXPR) &BODY BODY) @@ -446,7 +495,7 @@ ; becomes - (when-found val (gethash :foo hash) + (when-found (val (gethash :foo hash)) body) @@ -1745,10 +1794,12 @@ ### `MAKE-WEIGHTLIST` (function) - (MAKE-WEIGHTLIST ITEMS WEIGHTS) + (MAKE-WEIGHTLIST WEIGHTS-AND-ITEMS) Make a weightlist of the given items and weights. + `weights-and-items` should be an alist of `(weight . item)` pairs. + Weights can be any `real` numbers. Weights of zero are fine, as long as at least one of the weights is nonzero (otherwise there's nothing to choose). diff -r 15ab2e1331a1 -r 61ec616b45f8 losh.lisp --- a/losh.lisp Tue Jul 04 15:18:11 2017 +0000 +++ b/losh.lisp Fri Aug 04 23:13:23 2017 -0400 @@ -241,6 +241,7 @@ (single-float single-float-epsilon) (double-float double-float-epsilon))) + (defun-inlineable randomp (&optional (chance 0.5)) "Return a random boolean with `chance` probability of `t`." (< (random 1.0) chance)) @@ -416,7 +417,8 @@ ,@body)) (recur ,@(mapcar #'extract-val bindings))))) -(defmacro when-found (var lookup-expr &body body) + +(defmacro when-found ((var lookup-expr) &body body) "Perform `body` with `var` bound to the result of `lookup-expr`, when valid. `lookup-expr` should be an expression that returns two values, the first being @@ -434,7 +436,7 @@ ; becomes - (when-found val (gethash :foo hash) + (when-found (val (gethash :foo hash)) body) " @@ -446,7 +448,7 @@ (when ,found ,@body)))) -(defmacro if-found (var lookup-expr then else) +(defmacro if-found ((var lookup-expr) then else) "Perform `then` or `else` depending on the results of `lookup-expr`. `lookup-expr` should be an expression that returns two values, the first being @@ -467,7 +469,7 @@ ; becomes - (if-found val (gethash :foo hash) + (if-found (val (gethash :foo hash)) 'yes 'no) @@ -479,6 +481,7 @@ ,then) ,else)))) + (defmacro gathering (&body body) "Run `body` to gather some things and return a fresh list of them. @@ -556,6 +559,7 @@ ,@body) ,result)))) + (defmacro when-let* (binding-forms &body body) "Bind the forms in `binding-forms` in order, short-circuiting on `nil`. @@ -593,6 +597,7 @@ (when ,symbol (when-let* ,remaining-bindings ,@body)))))) + (defmacro multiple-value-bind* (bindings &body body) "Bind each pair in `bindings` with `multiple-value-bind` sequentially. @@ -615,6 +620,41 @@ (multiple-value-bind* ,bindings ,@body))))) +(defmacro do-repeat (n &body body) + "Perform `body` `n` times." + `(dotimes (,(gensym) ,n) + ,@body)) + +(defmacro do-range (ranges &body body) + "Perform `body` on the given `ranges`. + + Each range in `ranges` should be of the form `(variable from below)`. During + iteration `body` will be executed with `variable` bound to successive values + in the range [`from`, `below`). + + If multiple ranges are given they will be iterated in a nested fashion. + + Example: + + (do-range ((x 0 3) + (y 10 12)) + (pr x y)) + ; => + ; 0 10 + ; 0 11 + ; 1 10 + ; 1 11 + ; 2 10 + ; 2 11 + + " + (if (null ranges) + `(progn ,@body) + (destructuring-bind (var from below) (first ranges) + `(loop :for ,var :from ,from :below ,below + :do (do-range ,(rest ranges) ,@body))))) + + ;;;; Mutation ----------------------------------------------------------------- (eval-when (:compile-toplevel :load-toplevel :execute) (defun build-zap (place expr env) @@ -793,7 +833,7 @@ (defun-inlineable bisect-left (predicate vector target) - "Bisect `vector` based on `(predicate el target)` and return the LEFT element + "Bisect `vector` based on `(predicate el target)` and return the LEFT element. `vector` must be sorted (with `predicate`) before this function is called (this is not checked). @@ -839,7 +879,7 @@ (setf top index)))))) (defun-inlineable bisect-right (predicate vector target) - "Bisect `vector` based on `(predicate el target)` and return the RIGHT element + "Bisect `vector` based on `(predicate el target)` and return the RIGHT element. `vector` must be sorted (with `predicate`) before this function is called (this is not checked). @@ -885,6 +925,21 @@ (setf top index)))))) +(defun vector-last (vector) + "Return the last element of `vector`, or `nil` if it is empty. + + A second value is returned, which will be `t` if the vector was not empty and + `nil` if it was. + + The vector's fill-pointer will be respected. + + " + (let ((length (length vector))) + (if (zerop length) + (values nil nil) + (values (aref vector (1- length)) t)))) + + ;;;; Queues ------------------------------------------------------------------- ;;; Based on the PAIP queues (thanks, Norvig), but beefed up a little bit to add ;;; tracking of the queue size. @@ -2131,18 +2186,22 @@ (defstruct (weightlist (:constructor %make-weightlist)) weights sums items total) -(defun make-weightlist (items weights) +(defun make-weightlist (weights-and-items) "Make a weightlist of the given items and weights. + `weights-and-items` should be an alist of `(weight . item)` pairs. + Weights can be any `real` numbers. Weights of zero are fine, as long as at least one of the weights is nonzero (otherwise there's nothing to choose). " - (%make-weightlist - :items items - :weights weights - :sums (prefix-sums weights) - :total (apply #'+ weights))) + (let ((weights (mapcar #'car weights-and-items)) + (items (mapcar #'cdr weights-and-items))) + (%make-weightlist + :items items + :weights weights + :sums (prefix-sums weights) + :total (apply #'+ weights)))) (defun weightlist-random (weightlist) "Return a random item from the weightlist, taking the weights into account." @@ -2223,6 +2282,7 @@ (pq-insert pq element priority))) pq) + (defun pq-dequeue (pq) "Remove and return the element in `pq` with the lowest-numbered priority. diff -r 15ab2e1331a1 -r 61ec616b45f8 package.lisp --- a/package.lisp Tue Jul 04 15:18:11 2017 +0000 +++ b/package.lisp Fri Aug 04 23:13:23 2017 -0400 @@ -30,7 +30,8 @@ :fill-multidimensional-array :fill-multidimensional-array-t :fill-multidimensional-array-fixnum - :fill-multidimensional-array-single-float)) + :fill-multidimensional-array-single-float + :vector-last)) (defpackage :losh.bits (:documentation "Utilities for low-level bit stuff.") @@ -69,7 +70,9 @@ :gathering-vector :gather :when-let* - :multiple-value-bind*)) + :multiple-value-bind* + :do-repeat + :do-range)) (defpackage :losh.debugging (:documentation "Utilities for figuring out what the hell is going on.")