/usr/share/common-lisp/source/kmrcl/functions.lisp is in cl-kmrcl 1.106-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: functions.lisp
;;;; Purpose: Function routines for KMRCL package
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
(in-package :kmrcl)
(defun memo-proc (fn)
"Memoize results of call to fn, returns a closure with hash-table"
(let ((cache (make-hash-table :test #'equal)))
#'(lambda (&rest args)
(multiple-value-bind (val foundp) (gethash args cache)
(if foundp
val
(setf (gethash args cache) (apply fn args)))))))
(defun memoize (fn-name)
(setf (fdefinition fn-name) (memo-proc (fdefinition fn-name))))
(defmacro defun-memo (fn args &body body)
"Define a memoized function"
`(memoize (defun ,fn ,args . ,body)))
(defmacro _f (op place &rest args)
(multiple-value-bind (vars forms var set access)
(get-setf-expansion place)
`(let* (,@(mapcar #'list vars forms)
(,(car var) (,op ,access ,@args)))
,set)))
(defun compose (&rest fns)
(if fns
(let ((fn1 (car (last fns)))
(fns (butlast fns)))
#'(lambda (&rest args)
(reduce #'funcall fns
:from-end t
:initial-value (apply fn1 args))))
#'identity))
|