kclpatch.lsp

   1 ;;;; kclpatch -- Additions to AKCL from CTtL2
   2 ;;;;
   3 ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for
   4 ;;;; unrestricted use.
   5
   6 (provide "kclpatch")
   7
   8 (in-package 'lisp-stat-basics)
   9
  10 ;;;;
  11 ;;;; This file adds some functions from CLtL2 to AKCL. These functions
  12 ;;;; were not available in AKCL-1-600 but may become available at a
  13 ;;;; later date. I have added them to the LISP-STAT-BASICS package;
  14 ;;;; perhaps they ought to be put in the LISP package.
  15 ;;;;
  16
  17 (export '(function-lambda-expression realp fixnump))
  18
  19 (defun function-lambda-expression (f)
  20   (cond
  21    ((and (functionp f) (consp f))
  22     (case (first f)
  23      (lambda-block
  24       (values (cons 'lambda (nthcdr 2 f)) nil (second f)))
  25      (lambda-closure
  26       (values (cons 'lambda (nthcdr 4 f))
  27               (not (and (null (second f))
  28                         (null (third f))
  29                         (null (fourth f))))
  30               nil))
  31      (lambda-block-closure
  32       (values (cons 'lambda (nthcdr 5 f))
  33               (not (and (null (second f))
  34                         (null (third f))
  35                         (null (fourth f))))
  36               (fifth f)))
  37      (t (error "unknown function type"))))
  38     ((functionp f) (values nil t nil))
  39     (t (error "not a function - ~s" f))))
  40
  41 (defun realp (x)
  42 "Args: (x)
  43 Returns T if X is a real number; NIL otherwise."
  44   (declare (inline rationalp floatp))
  45   (or (rationalp x) (floatp x)))
  46
  47 ;;; Many CL's provide a fixnump somewhere. (A)KCL does not, so the one
  48 ;;; from ls-basics is exported here.