hyotang666

(defun find-all(item seq &rest args &key(test #'eql)test-not &allow-other-keys)
  (apply #'remove item seq :test(when test-not test-not)
                           :test-not(unless test-not test)args))

hyotang666

(defun flatten(tree)
  (let((result nil)
       (head(car tree))
       (tail(cdr tree)))
    (tagbody top
      (if(and(null tail)(null head))
        (return-from flatten (nreverse result))
        (if(consp head)
	        (progn
	          (push(cdr head)tail)

hyotang666

;;;; design

;;; (enable-literal-hash) => T ; implementation dependent.
;;; (gethash :a #H((:a . :b))) => :B ; T
;;; (princ #H((:a . :b)))
;;; #H((:a . :b)) ; side effect.
;;; => #<HASHTABLE 12345678>

(in-package :cl-user)
(defpackage :literal-hash(:use :cl)

hyotang666

;;; $ cat /dev/urandom | tr -cd [:alnum:] | fold -w 15 | head -n 5
;;; See CLHS especially alpha-char-p digit-char-p upper-case-p lower-case-p graphic-char-p alphanumericp
;;; when you need get radix 16 strings, you can use (lambda(c)(digit-char-p c 16))

(loop :repeat 5 :do (write-line(random-string 15 #'alphanumericp)))

(defun random-string(length &optional (pred #'characterp))
  (with-open-file(s "/dev/urandom" :element-type '(signed-byte 8))
    (loop :with string = (make-string length)
          :for index :upfrom 0 :below length

hyotang666

(defun zundoko()
  (do((bit(random 2)(random 2))
      (memory 0 (shift memory bit)))
    ((= #b11110 memory)(princ :kiyoshi!))
    (if(zerop bit)
      (princ :doko)
      (princ :zun))))

(defun shift(memory bit)
  (ldb(byte 5 0)(dpb bit(byte 1 0)(ash memory 1))))

hyotang666

(defun packages-made-by(system)
  (if(find system (asdf:already-loaded-systems):test #'string-equal)
    (warn "System ~S is already loaded."system)
    (let((depends-on(asdf:system-depends-on(asdf:find-system system))))
      (when depends-on
        (ql:quickload depends-on :silent t)) ; setup
      (let((old(list-all-packages))) ; keep olds state
        (ql:quickload system :silent t) ; install new
        (set-difference(list-all-packages)old)))))

hyotang666

(defmacro my-let(binds &body body)
  `((lambda,(mapcar #'ensure-car binds)
      ,@body)
    ,@(mapcar #'init-form binds)))

(defun ensure-car (arg)
  (if(listp arg)
    (car arg)
    arg))

hyotang666

(declaim(ftype(function((mod #.most-positive-fixnum))(mod #.most-positive-fixnum))fib))

(eval-when(:execute :load-toplevel :compile-toplevel)

  (defun fib (n)
    (declare(optimize (speed 3)(safety 0)))
    (if (< n 2)
      n
      (+ (fib (- n 2))
         (fib (- n 1)))))

hyotang666

(defmacro with-random-var((var num)&body body)
  (let((gvar(gensym "VAR")))
      `(LET((,gvar ,num))
           (SYMBOL-MACROLET((,var (RANDOM ,gvar)))
              ,@body))))

#+usage
(with-random-var(symbol 100)
  (+ symbol symbol))
; => (+ (random 100)(random 100))

hyotang666

(defun make-package-name(pathname)
  (values ; to discard second value.
    (read-from-string ; to use implementation dependent readtable case.
      (namestring(make-pathname :type nil :defaults pathname)))))

(defun load-as-package(pathname)
  (let((package-name(make-package-name(enough-namestring pathname (uiop:getcwd)))))
    (let((*package*(or (find-package package-name)
		       (make-package package-name :use '(:cl)))))
      (uiop:load* pathname))))