flambard

(defmacro precompiled-lambda (lambda-list &body body)
  (compile nil `(lambda ,lambda-list ,@body)))

(defmacro use ((&rest vars) &body body)
  `(funcall (precompiled-lambda ,vars ,@body) ,@vars))

flambard

(defmacro chip-8-program (subroutines &body code)
  `(let ((v0 0) (v1 0) (v2 0) (v3 0) (v4 0) (v5 0) (v6 0) (v7 0)
         (v8 0) (v9 0) (vA 0) (vB 0) (vC 0) (vD 0) (vE 0) (vF 0)
         (I  0) (DT 0)
         (memory (make-ram)))
     (declare (type (unsigned-byte 16) I))
     (declare (type (unsigned-byte 8) DT
                    v0 v1 v2 v3 v4 v5 v6 v7
                    v8 v9 vA vB vC vD vE vF))
     (labels ,subroutines

flambard

(defmacro defun-multi (name &body clauses)
  (let ((vars-sym (gensym "VARS")))
    `(defun ,name (&rest ,vars-sym)
       (ecase (length ,vars-sym)
         ,@(loop
              for (vars . body) in clauses
              collect `(,(length vars)
                         (destructuring-bind ,vars ,vars-sym ,@body))))) ))

flambard

(defstruct (simple-vector-pattern (:include constructor-pattern)
                                  (:constructor make-simple-vector-pattern (&rest subpatterns))))

(defmethod destructor-equal ((x simple-vector-pattern) (y simple-vector-pattern))
  (= (constructor-pattern-arity x)
     (constructor-pattern-arity y)))

(defmethod destructor-predicate-form ((pattern simple-vector-pattern) var)
  `(typep ,var '(simple-vector ,(constructor-pattern-arity pattern))))

flambard

(require 'timeclock)
(require 'cl)

(defun timelog-read-date ()
 (save-excursion
    (beginning-of-line)
    (buffer-substring-no-properties (+ 2 (point)) (+ 12 (point)))))

(defun timelog-read-time (&optional use-current-time-if-eobp)
  (if (and (eobp) use-current-time-if-eobp)

flambard

;; MATCH -- A CASE-like construct with pattern matching.

;; Syntax:
;;
;; (match expr
;;   (pattern1 . body1)
;;   (pattern2 . body2)
;;   ...
;;   (patternN . bodyN))
;;