Data commit

Task/Collections/Common-Lisp/collections-1.lisp

@@ -0,0 +1,41 @@
+CL-USER> (let ((list '())
+               (hash-table (make-hash-table)))
+           (push 1 list)
+           (push 2 list)
+           (push 3 list)
+           (format t "~S~%" (reverse list))
+           (setf (gethash 'foo hash-table) 42)
+           (setf (gethash 'bar hash-table) 69)
+           (maphash (lambda (key value)
+                      (format t "~S => ~S~%" key value))
+                    hash-table)
+           ;; or print the hash-table in readable form
+           ;; (inplementation-dependent)
+           (write hash-table :readably t)
+           ;; or describe it
+           (describe hash-table)
+           ;; describe the list as well
+           (describe list))
+;; FORMAT on a list
+(1 2 3)
+;; FORMAT on a hash-table
+FOO => 42
+BAR => 69
+;; WRITE :readably t on a hash-table
+#.(SB-IMPL::%STUFF-HASH-TABLE
+   (MAKE-HASH-TABLE :TEST 'EQL :SIZE '16 :REHASH-SIZE '1.5
+                    :REHASH-THRESHOLD '1.0 :WEAKNESS 'NIL)
+   '((BAR . 69) (FOO . 42)))
+;; DESCRIBE on a hash-table
+#<HASH-TABLE :TEST EQL :COUNT 2 {1002B6F391}>
+  [hash-table]
+
+Occupancy: 0.1
+Rehash-threshold: 1.0
+Rehash-size: 1.5
+Size: 16
+Synchronized: no
+;; DESCRIBE on a list
+(3 2 1)
+  [list]
+; No value

Task/Collections/Common-Lisp/collections-2.lisp

@@ -0,0 +1,36 @@
+;;; Obtained from Usenet,
+;;; Message-ID: <b3b1cc90-2e2b-43c3-b7d9-785ae29870e7@e23g2000prf.googlegroups.com>
+;;; Posting by Kaz Kylheku, February 28, 2008.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun bisect-list (list &optional (minimum-length 0))
+    (do ((double-skipper (cddr list) (cddr double-skipper))
+         (single-skipper list (cdr single-skipper))
+         (length 2 (+ length (if (cdr double-skipper) 2 1))))
+      ((null double-skipper)
+       (cond
+         ((< length minimum-length)
+          (values list nil))
+         ((consp single-skipper)
+          (multiple-value-prog1
+            (values list (cdr single-skipper))
+            (setf (cdr single-skipper) nil)))
+         (t (values list nil))))))
+
+  (defun pop-deque-helper (facing-piece other-piece)
+    (if (null facing-piece)
+      (multiple-value-bind (head tail) (bisect-list other-piece 10)
+        (let ((remaining (if tail head))
+              (moved (nreverse (or tail head))))
+          (values (first moved) (rest moved) remaining)))
+      (values (first facing-piece) (rest facing-piece) other-piece))))
+
+(defmacro pop-deque (facing-piece other-piece)
+  (let ((result (gensym))
+        (new-facing (gensym))
+        (new-other (gensym)))
+    `(multiple-value-bind (,result ,new-facing ,new-other)
+                          (pop-deque-helper ,facing-piece ,other-piece)
+       (psetf ,facing-piece ,new-facing
+              ,other-piece ,new-other)
+       ,result)))