;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;                                                          ;;;;;;;;
;;;;;;  All files in this directory or any subdirectories are   ;;;;;;;;
;;;;;;  copyright 1997, 1998, 1999, 2000, 2002.                 ;;;;;;;;
;;;;;;  by Rafael D. Sorkin.  All rights reserved.              ;;;;;;;;
;;;;;;                                                          ;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; bibliotek.general.gcl.l       Time-stamp:<2002-Oct-23 14:25:23 15798.59795>

;; This is bibliotek.general.gcl, a "sub-bibliotek" of bibliotek.general
;; and in fact a "sub-sub-bibliotek" since it's also subordinate to
;; bibliotek.general.tcl
;;    
;; It contains functions whose gcl definition is idiosyncratic.
;; It is needed only because defun's not at top level seem not to get compiled
;; by gcl!
;;    
;; This is loaded AFTER bibliotek.general.l

(deff product-m (XX) " Multiplies together the numbers in a list"
  (cond
   ((null XX) 1)
   (otherwise
    (varbind P (car XX))
    (loop for x in (cdr XX) do (setq P (* x P)))
    P)))

(defalias 'product 'product-m)  

(deff sum-m (XX) " Adds up the numbers in a list"
  (cond
   ((null XX) 0)
   (otherwise
    (varbind P (car XX))
    (loop for x in (cdr XX) do (setq P (+ x P)))
    P)))

(defalias 'sum 'sum-m)


(deff ! (n) "Factorial of INTEGER argument"
  (assert (integerp n) nil  "The function `!' takes integers only")
  (cond 
    ((< n 0) Infinity%)
    ((= n 0) 1)
    (t (* n (! (1- n))))))
 ;
 ; Since `!' is built into some TCL implementations, we don't define it in
 ; bib.gen.tcl (It seems not to be present in CLtL1, cmucl or gcl, but Clisp
 ; definitely does have it.)


(deff sgn (x) 
  "\
 The signum function, returning -1 0 1 
 The latter is actually built in, but we demand the arg to be real.  \
 This is a special version for gcl
  "
  (assert (realp x))
  (cond
   ((= x  Infinity%) +1)
   ((= x -Infinity%) -1)
   (t
    (vbind y (signum x))
    (cond
     ((= y  0)  0)
     ((= y  1)  1)
     ((= y -1) -1)
     (t (error "bad argument to `sgn': ~s" x))))))
 ;
 ; BEWARE  This has trouble with NaN (in gcl)
 ;
 ; The reason for the contortions is that in gcl (currently) NaN gives stupid
 ; results otherwise.  Eg it thinks sometimes that NaN < 0 !
 ; but on the other hand it does NOT realize that Inf > 0 ! 


;: End