This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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))))) )) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; MATCH -- A CASE-like construct with pattern matching. | |
;; Syntax: | |
;; | |
;; (match expr | |
;; (pattern1 . body1) | |
;; (pattern2 . body2) | |
;; ... | |
;; (patternN . bodyN)) | |
;; |