send-funcs.lisp

   1 ;;;-----------------------------------------------------------------------------------
   2 ;;; name       : send-func.lisp
   3 ;;; description: the compiler-macro 'sendable-function' stores a sendable
   4 ;;;              representation of a function (it's interpretable code).
   5 ;;; notes      : At the moment this works just in the empty environment.
   6 ;;;              It can't cope with closures or static variables.
   7 ;;; contact    : me (Michael Trowe)
   8 ;;; copyright  : You wanna copy this code? You fool!!!
   9 ;;; history    :
  10 ;;; contents   :
  11 ;;;-----------------------------------------------------------------------------------
  12 (in-package nc)
  13 (defvar *ncl-readtable* ())
  14 (define-compiler-macro sendable-function (denom)
  15   `(load-time-value
  16     (let ((func (compile nil ',denom)))
  17       (store-denom ',denom func)
  18       func)))
  19
  20 (defmacro sendable-function (denom)
  21   `(function ,denom))
  22
  23 (defun |#>-reader| (stream subchar arg)
  24   (declare (ignore subchar arg))
  25   (list 'sendable-function (read stream t nil t)))
  26
  27 (set-dispatch-macro-character #\# #\> #'|#>-reader|)
  28
  29 (setq *ncl-readtable* *readtable*)
  30
  31 (let ((denoms (make-hash-table)))
  32   (defun store-denom (denom func)
  33     (setf (gethash func denoms) denom)
  34     func)
  35   (defun get-denom (func)
  36     (or (gethash func denoms)
  37         (f-denominator func))))
  38
  39 (defun f-denominator (func)
  40   (multiple-value-bind (expr x name)
  41       (function-lambda-expression func)
  42     (declare (ignore x))
  43     (cond ((and name (symbolp name))
  44            name)
  45           (t expr))))
  46
  47