117 lines
3.8 KiB
Plaintext
117 lines
3.8 KiB
Plaintext
;; -*- mode: lisp-data -*-
|
|
|
|
;; Defining macros and functions
|
|
(fset 'defmacro (cons 'macro
|
|
(lambda (name lambda-list &rest body)
|
|
"Define NAME to be a macro."
|
|
(declare (name defmacro))
|
|
(list 'fset (list 'quote name)
|
|
(list 'cons
|
|
(quote 'macro)
|
|
(list* 'lambda lambda-list
|
|
(list 'declare (list 'name name))
|
|
body))))))
|
|
|
|
(defmacro defun (name lambda-list &rest body)
|
|
"Define NAME to be a function."
|
|
(list 'fset (list 'quote name)
|
|
(list* 'lambda lambda-list
|
|
(list 'declare (list 'name name))
|
|
body)))
|
|
|
|
;; List indicies
|
|
(defun first (list)
|
|
"Return the first element of LIST."
|
|
(car list))
|
|
(defun second (list)
|
|
"Return the second element of LIST."
|
|
(car (cdr list)))
|
|
(defun third (list)
|
|
"Return the third element of LIST."
|
|
(car (cdr (cdr list))))
|
|
(defun fourth (list)
|
|
"Return the fourth element of LIST."
|
|
(car (cdr (cdr (cdr list)))))
|
|
(defun fifth (list)
|
|
"Return the fifth element of LIST."
|
|
(car (cdr (cdr (cdr (cdr list))))))
|
|
(defun sixth (list)
|
|
"Return the sixth element of LIST."
|
|
(car (cdr (cdr (cdr (cdr (cdr list)))))))
|
|
(defun seventh (list)
|
|
"Return the seventh element of LIST."
|
|
(car (cdr (cdr (cdr (cdr (cdr (cdr list))))))))
|
|
(defun eighth (list)
|
|
"Return the eighth element of LIST."
|
|
(car (cdr (cdr (cdr (cdr (cdr (cdr (cdr list)))))))))
|
|
(defun ninth (list)
|
|
"Return the ninth element of LIST."
|
|
(car (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr list))))))))))
|
|
(defun tenth (list)
|
|
"Return the tenth element of LIST."
|
|
(car (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr list)))))))))))
|
|
|
|
;; Utility macros
|
|
(defmacro when (cond &rest body)
|
|
"Evaluate BODY if COND evaluates to non-nil."
|
|
(list 'if cond
|
|
(cons 'progn body)))
|
|
|
|
(defmacro unless (cond &rest body)
|
|
"Evaluate BODY if COND evaluates to nil."
|
|
(list* 'if cond
|
|
nil
|
|
body))
|
|
|
|
(defmacro dolist (spec &rest body)
|
|
"Evaluate BODY for each element of a list.
|
|
Spec is of the form (VARIABLE LIST &optional RETURN-FORM)."
|
|
(unless (and (or (length= spec 2) (length= spec 3))
|
|
(symbolp (car spec)))
|
|
(signal 'error (list spec)))
|
|
(let ((list-var (make-symbol "--dolist-list--"))
|
|
(cur-var (make-symbol "--dolist-cur--")))
|
|
(list 'let (list (list list-var (second spec))
|
|
cur-var)
|
|
(list 'while list-var
|
|
(list 'setq cur-var (list 'car list-var))
|
|
(list* 'let (list (list (first spec) cur-var))
|
|
body)
|
|
(list 'setq list-var (list 'cdr list-var)))
|
|
(when (third spec)
|
|
(list 'let (list (list (first spec) cur-var))
|
|
(third spec))))))
|
|
|
|
;; List functions
|
|
(defun mapcar (function list)
|
|
"Apply FUNCTION to each element of LIST and return a list of the results."
|
|
(let (start end)
|
|
(dolist (elt list)
|
|
(let ((res (funcall function elt)))
|
|
(if (null start)
|
|
(progn
|
|
(setq start (list res)
|
|
end start))
|
|
(rplacd end (list res))
|
|
(setq end (cdr end)))))
|
|
start))
|
|
|
|
(defun mapc (function list)
|
|
"Apply FUNCTION to each element of LIST, then return LIST."
|
|
(dolist (elt list list)
|
|
(funcall function elt)))
|
|
|
|
;; Some other functions
|
|
(defun terpri (&optional print-char-fun)
|
|
"Print a newline to PRINT-CHAR-FUN, then flush it."
|
|
(let ((fun (or print-char-fun #'write-byte)))
|
|
(funcall fun ?\n)
|
|
(funcall fun nil)))
|
|
|
|
(defun princln (datum &optional print-char-fun)
|
|
"`princ' DATUM to PRINT-CHAR-FUN, then do a `terpri'."
|
|
(princ datum print-char-fun)
|
|
(terpri print-char-fun))
|
|
|
|
(princln (nconc '(1 2) '(4 . 6) '(3 4)))
|