contents of randomsnippets.lisp

(defun make-gensym-list (length &optional (x "G"))
  "Returns a list of LENGTH gensyms, each generated as if with a call to MAKE-GENSYM,
using the second (optional, defaulting to \"G\") argument."
  (let ((g (if (typep x '(integer 0)) x (string x))))
    (loop repeat length
          collect (gensym g))))

(define-compiler-macro rcurry (function &rest arguments)
  (let ((rcurries (make-gensym-list (length arguments) "RCURRY"))
        (fun (gensym "FUN")))
    `(let ((,fun (ensure-function ,function))
           ,@(mapcar #'list rcurries arguments))
       (declare (optimize (speed 3) (safety 1)))
       (function(lambda (&rest more)
         (declare (dynamic-extent more))
         (multiple-value-call ,fun (values-list more) ,@rcurries))))
))

(defun ensure-function (function-designator)
  "Returns the function designated by FUNCTION-DESIGNATOR:
if FUNCTION-DESIGNATOR is a function, it is returned, otherwise
it must be a function name and its FDEFINITION is returned."
  (if (functionp function-designator)
      function-designator
      (fdefinition function-designator)))

(defmacro partial (fn &rest args)
  `(function (lambda (&rest more-args)
     (apply ,fn ,@args more-args))))



(defmacro o (&rest fn)
    (flet ((wrap (x) (if (symbolp x) `#',x x)))
    (let ((args (gensym "ARGS")))
      `(lambda (&rest ,args)
         ,(reduce (lambda (acc x)
                    (list 'funcall (wrap x) acc))
                  (butlast fn)
                  :initial-value `(apply ,(wrap (car (last fn))) ,args))))))