kurohuku

(defvar *arch-type* "i386")

(defun make-disasm-command (target file)
  (format "objdump -b binary -m %s -D %s" target file))

(defun make-perl-command (lst tmp-file)
  (concat
   "perl -e 'print \""
   (apply
    'concat

kurohuku

(defvar gauche-apropos-result-list nil)

(defun eval-gauche-apropos (str)
  (process-send-string
   (scheme-proc)
   (format "(apropos '%s)\n" str)))

(defun gauche-apropos-filter (proc str)
  (insert str))

kurohuku

(defmacro update/fn-1! (generaized-variable update-fn &rest args)
  (let ((old-val (gensym)))
    `(let ((,old-val ,generaized-variable))
      (setf ,generaized-variable (funcall ,update-fn ,old-val ,@args))
      ,old-val)))

(defmacro update/fn-2! (generaized-variable update-fn &rest args)
  `(setf ,generaized-variable (funcall ,update-fn ,generaized-variable ,@args)))

(defmacro update/fn-r-1 (generaized-variable update-fn &rest args)

kurohuku

(defmacro switch-2 (val &body clauses)
  (let ((break (gensym)))
    `(macrolet ((break-switch ()
		 `(throw ',',break nil)))
      (catch ',break
	(case ,val
	  ,@(maplist
	     #'(lambda (clauses)
		 `(,(caar clauses) ,@(mapcan #'cdr clauses)))

kurohuku

(defmacro switch (val &body clauses)
  (let ((syms (loop :repeat (length clauses)
                 :collect (gensym))))
    `(tagbody
        (case ,val
          ,@(mapcar
             #'(lambda (clause sym)
                 `(,(car clause) (go ,sym)))
             clauses
             syms))

kurohuku

(defmacro with-assoc-values (binds alist &body body)
  (let ((al (gensym "alist")))
    (flet ((expand-bind (bind)
	     `(,(first bind)
	       (cdr (assoc ,(second bind) ,al)))))
      `(let ((,al ,alist))
	(let ,(mapcar #'expand-bind binds)
	  ,@body)))))
			  
;; (with-assoc-values ((a :hoge) (b :fuga)) `((:hoge . (3 4)) (:fuga . 4))

kurohuku

;;; examples
(def-binary-raw u1
  ;; reader
  ([type in]
     (bit-and 255 (.read in)))
  ;; writer
  ([type value out]
     (.write out)))

(def-binary-raw u2

kurohuku

(defun kill-to-regexp-forward (regexp)
  (interactive "sRegexp:")
  (let ((start-point (point)))
    (when (re-search-forward regexp nil t)
      (re-search-backward regexp nil t)
      (kill-region start-point (point)))))

(defun kill-to-regexp-backward (regexp)
  (interactive "sRegexp:")

kurohuku

;;; loop
(defun split-str-1 (str sep)
  (labels ((sep? (ch)
	     (typecase sep
	       (function
		(funcall sep ch))
	       (list (find ch sep))
	       (sequence (find ch sep))
	       (atom (eq sep ch))	       
	       (T nil))))

kurohuku

(defun dotted-list-p (lst)
  (when (consp lst)
    (loop :for rest = (cdr lst) then (cdr rest)
	  :while (consp rest)
	  :finally (return (not (null rest))))))

(defun walk-inner (sexp pre mid post)
  (cond
    ((atom sexp)
     (funcall mid sexp))