(defun sha1 (str)
  (ironclad:byte-array-to-hex-string
    (ironclad::digest-sequence :sha1 (SB-EXT:STRING-TO-OCTETS str))))

;;; Replace the definition of NAME with a function that binds NAME's
;;; arguments to a variable named ARG-LIST, binds name's definition
;;; to a variable named BASIC-DEFINITION, and evaluates BODY in that
;;; context. TYPE is whatever you would like to associate with this
;;; encapsulation for identification in case you need multiple
;;; encapsulations of the same name.
(defun encapsulate (name type body)
  (let ((fdefn (fdefinition-object name nil)))
    (unless (and fdefn (fdefn-fun fdefn))
      (error 'undefined-function :name name))
    ;; We must bind and close over INFO. Consider the case where we
    ;; encapsulate (the second) an encapsulated (the first)
    ;; definition, and later someone unencapsulates the encapsulated
    ;; (first) definition. We don't want our encapsulation (second) to
    ;; bind basic-definition to the encapsulated (first) definition
    ;; when it no longer exists. When unencapsulating, we make sure to
    ;; clobber the appropriate INFO structure to allow
    ;; basic-definition to be bound to the next definition instead of
    ;; an encapsulation that no longer exists.
    (let ((info (make-encapsulation-info type (fdefn-fun fdefn))))
      (setf (fdefn-fun fdefn)
            (named-lambda encapsulation (&rest arg-list)
              (declare (special arg-list))
              (let ((basic-definition (encapsulation-info-definition info)))
                (declare (special basic-definition))
                (eval body)))))))

CL-USER(19): (defun gorm (x) (1+ x))
GORM
 
CL-USER(20): (SB-INT:ENCAPSULATE 'gorm 'identity '(apply sb-int:basic-definition sb-int:arg-list))
 
#<closure (SB-C::&OPTIONAL-DISPATCH SB-IMPL::ENCAPSULATION) {ACE428D}>
CL-USER(21): (gorm 10)
11
 
CL-USER(22): (SB-INT:ENCAPSULATE 'gorm 'add-five '(+ 5 (apply sb-int:basic-definition sb-int:arg-list)))
#</closure><closure (SB-C::&OPTIONAL-DISPATCH SB-IMPL::ENCAPSULATION) {ACEE31D}>
 
CL-USER(23): (gorm 10)
16
 
CL-USER(24): (SB-INT:ENCAPSULATE 'gorm 'add-seven '(+ 7 (apply sb-int:basic-definition sb-int:arg-list)))
 
#</closure><closure (SB-C::&OPTIONAL-DISPATCH SB-IMPL::ENCAPSULATION) {ACF84ED}>
CL-USER(25): (gorm)
23
</closure>

CL-USER(26): (SB-INT:UNENCAPSULATE 'gorm 'add-five)
T
 
CL-USER(27): (gorm 10)
18
 
CL-USER(28): (SB-INT:UNENCAPSULATE 'gorm 'add-seven)
T
 
CL-USER(29): (gorm 10)
11

(defun matches-magic (file magic &optional (offset 0))
    (with-open-file (s file :element-type '(unsigned-byte 8))
      (file-position s offset)
      (loop for c across magic
            unless (eql c (code-char (read-byte s)))
            do (return-from matches-magic))
      t))
 
(defun jpeg-p (file) ; won't catch Exif files with JPEG inside
  (matches-magic file "JFIF" 6))
 
(defun png-p (file)
  (matches-magic file "PNG" 1))
 
(defun gif-p (file)
  (matches-magic file "GIF89a"))
 
(defun canonical-image-extension (file)
  (cond
    ((png-p file) "png")
    ((gif-p file) "gif")
    ((jpeg-p file) "jpeg")))
 
(defmacro any-predicate (preds &rest args)
    `(or ,@(loop for p in preds
                 collect `(,p ,@args))))
 
(defun valid-image-p (file)
  (any-predicate (jpeg-p png-p gif-p) file))

(defun any-predicate (preds &rest args) ; largely untested
  (some #'identity (mapcar (lambda (x) (apply x args))  preds)))
 
(defun valid-image-p (file)
  (any-predicate (list #'jpeg-p #'png-p #'gif-p #'exif-p) file))

(define-file-type "jpeg" JFIF 6)

(let ((i 0))
  (mapcar (lambda (x)
            (when (eql (incf i) 3)
              (STOP-HERE)))
    '(a b c d)))

(tagbody (mapcar (lambda (x) (go X)) '(a b c)) X)

(block X (mapcar (lambda (x) (return-from X)) ‘(a b c)))

(walk (list (+ 5 (* 3 3))
            "Welcome to earth, third rock from the sun!"))
 
(* 3 3) => 9
(+ 5 (* 3 3)) => 14
(LIST (+ 5 (* 3 3)) "Welcome to earth, third rock from the sun!")
  => (14 "Welcome to earth, third rock from the sun!")

(defmacro walk (form)
    (etypecase form
       (atom ; terminating base case
         form)
       (cons
         `(let ((result (,(first form) ,@(mapcar (lambda (arg) `(walk ,arg))
                                               (rest form)))))
            (format t "~S => ~S~%" ',form result)
            result))))

(* 3 3) => 9
(+ 5 9) => 14
(LIST 14 "Welcome to earth, third rock from the sun!")
  => (14 "Welcome to earth, third rock from the sun!")