--- a/package.lisp Tue Jan 17 18:37:07 2017 +0000
+++ b/package.lisp Thu Jan 26 22:54:28 2017 +0000
@@ -3,7 +3,6 @@
:cl
:losh
:iterate
- :cl-arrows
:sand.quickutils)
(:export
:average4))
@@ -11,7 +10,6 @@
(defpackage :sand.primes
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -24,7 +22,6 @@
:cl
:losh
:iterate
- :cl-arrows
:sand.quickutils
:sand.utils))
@@ -33,7 +30,6 @@
:cl
:losh
:iterate
- :cl-arrows
:sandalphon.compiler-macro
:sand.quickutils
:sand.utils)
@@ -48,7 +44,6 @@
:cl
:losh
:iterate
- :cl-arrows
:sand.quickutils
:sand.utils))
@@ -57,7 +52,6 @@
:cl
:losh
:sand.quickutils
- :cl-arrows
:cl-fad
:parenscript)
(:shadowing-import-from :losh
@@ -68,7 +62,6 @@
:cl
:losh
:iterate
- :cl-arrows
:sand.quickutils
:sand.utils))
@@ -77,14 +70,12 @@
:cl
:losh
:iterate
- :cl-arrows
:sand.quickutils
:sand.utils))
(defpackage :sand.dijkstra-maps
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -99,7 +90,6 @@
(defpackage :sand.graphs
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -110,7 +100,6 @@
(defpackage :sand.graphviz
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -121,12 +110,13 @@
(defpackage :sand.ropes
(:use
:cl
- :cl-arrows
:losh
:iterate
:trivia
:sand.quickutils
:sand.utils)
+ (:shadowing-import-from :losh
+ :<>)
(:export
))
@@ -142,7 +132,6 @@
(defpackage :sand.binary-decision-diagrams
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.graphviz
@@ -154,7 +143,6 @@
(defpackage :sand.zero-suppressed-decision-diagrams
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.graphviz
@@ -167,7 +155,6 @@
(defpackage :sand.huffman-trees
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.graphviz
@@ -179,7 +166,6 @@
(defpackage :sand.streams
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.primes
@@ -192,7 +178,6 @@
(defpackage :sand.ffi
(:use
:cl
- :cl-arrows
:losh
:iterate
:cffi
@@ -204,7 +189,6 @@
(defpackage :sand.color-difference
(:use
:cl
- :cl-arrows
:losh
:iterate
:rs-colors
@@ -216,7 +200,6 @@
(defpackage :sand.story
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -227,7 +210,6 @@
(defpackage :sand.number-letters
(:use
:cl
- :cl-arrows
:losh
:iterate
:function-cache
@@ -239,7 +221,6 @@
(defpackage :sand.urn
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -250,7 +231,6 @@
(defpackage :sand.qud
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -261,7 +241,6 @@
(defpackage :sand.istruct
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -303,7 +282,6 @@
(defpackage :sand.profiling
(:use
:cl
- :cl-arrows
:losh
:iterate
:sand.quickutils
@@ -341,6 +319,5 @@
:cl
:losh
:iterate
- :cl-arrows
:sand.quickutils
:sand.utils))
--- a/src/istruct.lisp Tue Jan 17 18:37:07 2017 +0000
+++ b/src/istruct.lisp Thu Jan 26 22:54:28 2017 +0000
@@ -50,46 +50,46 @@
;;;; Definition ---------------------------------------------------------------
-(defun required (name)
- (error "Slot ~S is required" name))
-
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun required (name)
+ (error "Slot ~S is required" name))
-(defun build-slot (slot-spec)
- (destructuring-bind (slot-name &key default type) slot-spec
- `(,slot-name
- ,(if default
- default
- `(required ',slot-name))
- :read-only t
- ,@(when type `(:type ,type)))))
+ (defun build-slot (slot-spec)
+ (destructuring-bind (slot-name &key default type) slot-spec
+ `(,slot-name
+ ,(if default
+ default
+ `(required ',slot-name))
+ :read-only t
+ ,@(when type `(:type ,type)))))
-(defun build-immutable-struct-form (name slots)
- `(defstruct ,name
- ,@(mapcar #'build-slot slots)))
+ (defun build-immutable-struct-form (name slots)
+ `(defstruct ,name
+ ,@(mapcar #'build-slot slots)))
-(defun build-iset (name slots)
- `(defmethod iset ((instance ,name) slot new-value)
- (,(symb 'make- name)
- ,@(iterate (for (slot . nil) :in slots)
- (collect (ensure-keyword slot))
- (collect `(if (eq slot ',slot)
- new-value
- (slot-value instance ',slot)))))))
+ (defun build-iset (name slots)
+ `(defmethod iset ((instance ,name) slot new-value)
+ (,(symb 'make- name)
+ ,@(iterate (for (slot . nil) :in slots)
+ (collect (ensure-keyword slot))
+ (collect `(if (eq slot ',slot)
+ new-value
+ (slot-value instance ',slot)))))))
-(defun build-equal? (name slots)
- `(defmethod equal? ((a ,name) (b ,name))
- (and ,@(iterate (for (slot . nil) :in slots)
- (collect `(equal?
- (slot-value a ',slot)
- (slot-value b ',slot)))))))
+ (defun build-equal? (name slots)
+ `(defmethod equal? ((a ,name) (b ,name))
+ (and ,@(iterate (for (slot . nil) :in slots)
+ (collect `(equal?
+ (slot-value a ',slot)
+ (slot-value b ',slot)))))))
-(defun build-constructor (name slots)
- (let ((slot-names (mapcar #'first slots)))
- `(defun ,name ,slot-names
- (,(symb 'make- name)
- ,@(iterate (for slot :in slot-names)
- (collect (ensure-keyword slot))
- (collect slot))))))
+ (defun build-constructor (name slots)
+ (let ((slot-names (mapcar #'first slots)))
+ `(defun ,name ,slot-names
+ (,(symb 'make- name)
+ ,@(iterate (for slot :in slot-names)
+ (collect (ensure-keyword slot))
+ (collect slot)))))))
(defmacro define-istruct (name-and-options &rest slots)
--- a/src/random-numbers.lisp Tue Jan 17 18:37:07 2017 +0000
+++ b/src/random-numbers.lisp Thu Jan 26 22:54:28 2017 +0000
@@ -31,23 +31,26 @@
(type positive-fixnum modulus multiplier increment))
(let ((val (mod (logxor seed multiplier)
modulus)))
- (dlambda
- (:next ()
- (ldb (byte 32 16) ; java's j.u.Random only gives out 32 high-order bits
- (setf val (mod (+ (* val multiplier) increment)
- modulus))))
- (:modulus () modulus))))
+ (lambda (arg)
+ (case arg
+ (:next
+ (ldb (byte 32 16) ; java's j.u.Random only gives out 32 high-order bits
+ (setf val (mod (+ (* val multiplier) increment)
+ modulus))))
+ (:modulus
+ modulus)))))
(defun make-linear-congruential-rng (modulus multiplier increment seed)
(declare (type nonnegative-fixnum seed)
(type positive-fixnum modulus multiplier increment))
(let ((val (mod (logxor seed multiplier)
modulus)))
- (dlambda
- (:next ()
- (setf val (mod (+ (* val multiplier) increment)
- modulus)))
- (:modulus () modulus))))
+ (lambda (arg)
+ (case arg
+ (:next
+ (setf val (mod (+ (* val multiplier) increment)
+ modulus)))
+ (:modulus modulus)))))
(declaim (inline rng-next rng-modulus))