fd8c40ec26ee

Add `take` and `drop` from Serapeum
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Wed, 14 Dec 2016 12:16:13 -0500
parents e15746e52914
children e9910edd311c
branches/tags (none)
files DOCUMENTATION.markdown losh.lisp make-docs.lisp package.lisp

Changes

--- a/DOCUMENTATION.markdown	Thu Dec 08 13:19:52 2016 -0500
+++ b/DOCUMENTATION.markdown	Wed Dec 14 12:16:13 2016 -0500
@@ -90,6 +90,31 @@
 
   
 
+## Package `LOSH.CHILI-DOGS`
+
+Gotta go FAST.
+
+### `DEFUN-INLINE` (macro)
+
+    (DEFUN-INLINE NAME
+      &BODY
+      BODY)
+
+Like `defun`, but declaims `name` to be `inline`.
+
+### `DEFUN-INLINEABLE` (macro)
+
+    (DEFUN-INLINEABLE NAME
+      &BODY
+      BODY)
+
+Like `defun-inline`, but declaims `name` to be `notinline` afterword.
+
+  This is useful when you don't want to inline a function everywhere, but *do*
+  want to have the ability to inline it on demand with (declare (inline ...)).
+
+  
+
 ## Package `LOSH.CONTROL-FLOW`
 
 Utilities for managing control flow.
@@ -289,7 +314,7 @@
 
 ### `DIS` (macro)
 
-    (DIS ARGLIST
+    (DIS
       &BODY
       BODY)
 
@@ -745,28 +770,6 @@
 
   
 
-## Package `LOSH.LISTS`
-
-Utilities related to lists.
-
-### `TAKE` (function)
-
-    (TAKE N LIST)
-
-Return a fresh list of the first `n` elements of `list`.
-
-  If `list` is shorter than `n` a shorter result will be returned.
-
-  Example:
-
-    (take 2 '(a b c))
-    => (a b)
-
-    (take 4 '(1))
-    => (1)
-
-  
-
 ## Package `LOSH.MATH`
 
 Utilities related to math and numbers.
@@ -1093,6 +1096,28 @@
 
 Utilities for operating on sequences.
 
+### `DROP` (function)
+
+    (DROP N SEQ)
+
+Return a fresh copy of the `seq` without the first `n` elements.
+
+  The result will be of the same type as `seq`.
+
+  If `seq` is shorter than `n` an empty sequence will be returned.
+
+  Example:
+
+    (drop 2 '(a b c))
+    => (c)
+
+    (drop 4 #(1))
+    => #()
+
+  From Serapeum.
+
+  
+
 ### `FREQUENCIES` (function)
 
     (FREQUENCIES SEQUENCE &KEY (TEST 'EQL))
@@ -1182,6 +1207,28 @@
 
   
 
+### `TAKE` (function)
+
+    (TAKE N SEQ)
+
+Return a fresh sequence of the first `n` elements of `seq`.
+
+  The result will be of the same type as `seq`.
+
+  If `seq` is shorter than `n` a shorter result will be returned.
+
+  Example:
+
+    (take 2 '(a b c))
+    => (a b)
+
+    (take 4 #(1))
+    => #(1)
+
+  From Serapeum.
+
+  
+
 ## Package `LOSH.WEIGHTLISTS`
 
 A simple data structure for choosing random items with weighted probabilities.
--- a/losh.lisp	Thu Dec 08 13:19:52 2016 -0500
+++ b/losh.lisp	Wed Dec 14 12:16:13 2016 -0500
@@ -1,4 +1,4 @@
-(in-package #:losh)
+(in-package :losh)
 
 ;;;; Sanity -------------------------------------------------------------------
 (defmacro -<> (&rest forms)
@@ -11,8 +11,24 @@
        (-<> ,@(rest forms)))))
 
 
+;;;; Types --------------------------------------------------------------------
+(deftype array-index (&optional (length (1- array-dimension-limit)))
+  "An integer in the range `[0, length)`.
+
+  From Alexandria.
+
+  "
+  `(integer 0 (,length)))
+
+
 ;;;; Chili Dogs ---------------------------------------------------------------
 (defmacro defun-inlineable (name &body body)
+  "Like `defun-inline`, but declaims `name` to be `notinline` afterword.
+
+  This is useful when you don't want to inline a function everywhere, but *do*
+  want to have the ability to inline it on demand with (declare (inline ...)).
+
+  "
   `(progn
      (declaim (inline ,name))
      (defun ,name ,@body)
@@ -20,6 +36,7 @@
      ',name))
 
 (defmacro defun-inline (name &body body)
+  "Like `defun`, but declaims `name` to be `inline`."
   `(progn
      (declaim (inline ,name))
      (defun ,name ,@body)
@@ -539,26 +556,6 @@
              :collect `(%callf ,place ,function))))
 
 
-;;;; Lists --------------------------------------------------------------------
-(defun take (n list)
-  "Return a fresh list of the first `n` elements of `list`.
-
-  If `list` is shorter than `n` a shorter result will be returned.
-
-  Example:
-
-    (take 2 '(a b c))
-    => (a b)
-
-    (take 4 '(1))
-    => (1)
-
-  "
-  (iterate (repeat n)
-           (for item :in list)
-           (collect item)))
-
-
 ;;;; Arrays -------------------------------------------------------------------
 (declaim
   (ftype (function ((array * *) t)) fill-multidimensional-array)
@@ -1425,6 +1422,69 @@
     (finally (return result))))
 
 
+(defun-inline take-list (n list)
+  (iterate (declare (iterate:declare-variables))
+           (repeat n)
+           (for item :in list)
+           (collect item)))
+
+(defun-inline take-seq (n seq)
+  (subseq seq 0 (min n (length seq))))
+
+(defun take (n seq)
+  "Return a fresh sequence of the first `n` elements of `seq`.
+
+  The result will be of the same type as `seq`.
+
+  If `seq` is shorter than `n` a shorter result will be returned.
+
+  Example:
+
+    (take 2 '(a b c))
+    => (a b)
+
+    (take 4 #(1))
+    => #(1)
+
+  From Serapeum.
+
+  "
+  (check-type n array-index)
+  (etypecase seq
+    (list (take-list n seq))
+    (sequence (take-seq n seq))))
+
+
+(defun-inline drop-list (n list)
+  (copy-list (nthcdr n list)))
+
+(defun-inline drop-seq (n seq)
+  (subseq seq (min n (length seq))))
+
+(defun drop (n seq)
+  "Return a fresh copy of the `seq` without the first `n` elements.
+
+  The result will be of the same type as `seq`.
+
+  If `seq` is shorter than `n` an empty sequence will be returned.
+
+  Example:
+
+    (drop 2 '(a b c))
+    => (c)
+
+    (drop 4 #(1))
+    => #()
+
+  From Serapeum.
+
+  "
+  (check-type n array-index)
+  (etypecase seq
+    (list (drop-list n seq))
+    (sequence (drop-seq n seq))))
+
+
 ;;;; Debugging & Logging ------------------------------------------------------
 (defun pr (&rest args)
   "Print `args` readably, separated by spaces and followed by a newline.
@@ -1458,9 +1518,9 @@
 
   "
   `(prog1
-     (progn ,@(mapcar (lambda (arg) `(pr ',arg ,arg)) args))
-     (terpri)
-     (finish-output)))
+    (progn ,@(mapcar (lambda (arg) `(pr ',arg ,arg)) args))
+    (terpri)
+    (finish-output)))
 
 
 (defun bits (n size &optional (stream t))
@@ -1485,7 +1545,7 @@
          (*error-output* (make-broadcast-stream)))
     ,@body))
 
-(defmacro dis (arglist &body body)
+(defmacro dis (&body body)
   "Disassemble the code generated for a `lambda` with `arglist` and `body`.
 
   It will also spew compiler notes so you can see why the garbage box isn't
@@ -1494,9 +1554,13 @@
   "
   (let ((%disassemble #+sbcl 'sb-disassem:disassemble-code-component
                       #-sbcl 'disassemble))
-    `(,%disassemble (compile nil '(lambda ,arglist
-                                   (declare (optimize speed))
-                                   ,@body)))))
+    (destructuring-bind (arglist &body body)
+        (iterate (for b :first body :then (cdr b))
+                 (while (symbolp (car b)))
+                 (finally (return b)))
+      `(,%disassemble (compile nil '(lambda ,arglist
+                                     (declare (optimize speed))
+                                     ,@body))))))
 
 (defmacro comment (&body body)
   "Do nothing with a bunch of forms.
--- a/make-docs.lisp	Thu Dec 08 13:19:52 2016 -0500
+++ b/make-docs.lisp	Wed Dec 14 12:16:13 2016 -0500
@@ -4,6 +4,7 @@
   (list "LOSH"
 
         "LOSH.ARRAYS"
+        "LOSH.CHILI-DOGS"
         "LOSH.CONTROL-FLOW"
         "LOSH.DEBUGGING"
         "LOSH.ELDRITCH-HORRORS"
@@ -12,7 +13,6 @@
         "LOSH.HASH-TABLES"
         "LOSH.ITERATE"
         "LOSH.LICENSING"
-        "LOSH.LISTS"
         "LOSH.MATH"
         "LOSH.MUTATION"
         "LOSH.QUEUES"
--- a/package.lisp	Thu Dec 08 13:19:52 2016 -0500
+++ b/package.lisp	Wed Dec 14 12:16:13 2016 -0500
@@ -92,11 +92,6 @@
     :notf
     :callf))
 
-(defpackage :losh.lists
-  (:documentation "Utilities related to lists.")
-  (:export
-    :take))
-
 (defpackage :losh.arrays
   (:documentation "Utilities related to arrays.")
   (:export
@@ -186,7 +181,9 @@
     :prefix-sums
     :frequencies
     :proportions
-    :group-by))
+    :group-by
+    :take
+    :drop))
 
 (defpackage :losh.debugging
   (:documentation "Utilities for figuring out what the hell is going on.")
@@ -225,10 +222,17 @@
     :dlambda
     :define-with-macro))
 
+(defpackage :losh.chili-dogs
+  (:documentation "Gotta go FAST.")
+  (:export
+    :defun-inline
+    :defun-inlineable))
+
 
 (defpackage-inheriting :losh
   (:losh.arrays
 
+   :losh.chili-dogs
    :losh.control-flow
    :losh.debugging
    :losh.eldritch-horrors
@@ -237,7 +241,6 @@
    :losh.hash-tables
    :losh.iterate
    :losh.licensing
-   :losh.lists
    :losh.math
    :losh.mutation
    :losh.queues