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

; bibliotek.elisp.coda.el       Time-stamp:<2003-May-13 21:32:31 16065.40111>

;; Here we keep macros and functions for elisp that upset some TCL compilers
;; (They are here rather than in `bibliotek.elisp' so they can have access to
;; the macros defined in `bibliotek.macros')

;: Roster

;| Time and friends
;|
;|   Time (prints timing and memory use info)
;|   time-occupied (returns time) [in bibliotek.macros.el]
;|       time-evaluation (returns elapsed time itself)
;|   get-time (get current time in seconds)
;|   t_0 t_1 (names before "localization")(global vbles for `time-evaluation')
;|
;|   time	[commented out]
;|   Time-alt	[commented out]
;|
;|  Random
;|  random-from-elisp
;|  el:random    (prefixed to distinguish it from one in CL-package)
;|  random  (now just a dummy function)
;|
;|  sgn
;|  
;|  ratio (converts its args to float)
;|  reciprocal (alias 1/) 
;|
;|  sinh cosh tanh
;|
;|  !                   (factorial of integer argument -- elisp version only,
;|                       TCL version is in bibliotek.general)
;|  print-to-file
;|

;: Check we really are in elisp

 (unless *elisp* (error " Use { bibliotek.macros.elisp } only with elisp"))

;: Timing macros

(localize-using-name "timer-family" 
    (t_0 t_1 time-triple form body mem-use dt dmem z)

(defvar t_0)
(defvar t_1)

(defun get-time ()  
  "\
 Returns current time in seconds from some meaningless reference time
 circa 1970 Jan 1.    \
  "  
  (let ((time-triple (current-time)))
    (+
      (car time-triple)
      (nth 1 time-triple)  
      (* 0.000001 (nth 2 time-triple)))))
  ;
  ; NOTE the function `nth' is a subr in elisp, hence presumably faster than
  ; `cadr' and `caddr'

(defun time-evaluation (form) 
  "\
 SYNOPSIS (time-evaluation FORM)
 Timing is crude because only elapsed real time is measured -- not CPU time. 
 Evals FORM and returns the elapsed time in seconds. 
 (Does not collect garbage first)
 This is basically an auxiliary macro for `time-occupied'
 BEWARE On bananoid this behaved differently when enclosed in `progn'!
  "
  (setq t_0 (get-time))
  (eval form)
  (-  (get-time) t_0))

(defmacro Time (&rest body)
  "\
 SYNOPSIS (Time FORM)
 A crude timer for elisp that only measures elapsed real time, not CPU time. 
 Returns a string giving 
   (i) the elapsed time in seconds
  (ii) the total number of objects (not bytes) consed as determined 
       from `memory-use-counts' (qv).
 Deposits  in *mrv* the full result, including a breakdown of which types of
 objects were consed: 
  (conses floats vector-cells symbols string-chars miscs intervals).
 Collects garbage first to get a clean start.  
  "
  `(let ((mem-use nil) (dt nil) (dmem nil))
     (setq mem-use (memory-use-counts))
     (setq dt (time-occupied ,@body))
     (setq dmem (map 'list (function -) (memory-use-counts) mem-use))
     (setq *mrv* (list dt (sum dmem) dmem))
     (format "%0.2f [%d]" dt (sum dmem))))

; (defmacro Time-alt (&rest body)
;   " Same as `time' but collects garbage first"
;   `(progn
;      (garbage-collect)
;      (time
;       ,@body)))          
;
; (defun pp-elapsed-time (z) 
;   " Auxiliary function for `time'. Argument should be in seconds."
;   (cond
;     ((< z 0) (message "Negative elapsed time of %f seconds!" z))
;     (t  (princ (format "%0.3g sec elapsed (NOT CPU) tim" z)) 'e)))
;    ;
;    ; returning `e' is a kluge.
;
; (defmacro time (&rest body) 
;   "\
;  A crude timer, which measures elapsed real time (not CPU time)
;  and prints the result, which it obtains from the function `time-evaluation'.
;  The argument can be a single form or a series of them.
;  We do NOT collect garbage first.
;  (The actual return value is useless: the symbol `e').
;   "
;   `(pp-elapsed-time 
;     (time-evaluation
;      '(progn ,@body))))  
;    ;
;    ;  The use of `progn' somehow stabilized the timing (on bananoid)

)

;: Various functions 

(deff sgn (x) 
  "\
 The signum function, returning -1 0 1
 The argument should be a real number (including +-Infinity but EXCLUDING NaN).
 (For elisp, `sgn' turns out to coincide with the builtin function `signum',
 for TCL they differ because `signum' admits complex arguments.)   \
  "
  (cond
   ((> x 0)  1)
   ((< x 0) -1)
   ((= x 0)  0)
   (otherwise (error "Invalid argument to `sgn': %s" x))))

(defun ratio (x y) 
  "\
 Floats its arguments and then takes their ratio.  This is necessary with elisp
 since division of integers truncates the quotient to an integer!  \
  " 
  (/ (float x) (float y)))

(defalias 'ratio* 'ratio)

(defun reciprocal (x) 
   " First converts to float, since elisp truncates integer division" 
   (/ 1 (float x))) 

(defalias '1/ 'reciprocal)

(defun sinh(x) 
  (let ((y (exp x)))
    (/ (- y (reciprocal y)) 2)))

(defun cosh(x) 
  (let ((y (exp x)))
    (/ (+ y (reciprocal y)) 2)))

(defun tanh(x)
  (let* ((y (exp x))
	 (z (reciprocal y)))
    (/ (- y z) (+ y z))))


(defun ! (n) 
  "\
 Factorial function for integers -- from 0 to 170 only!  
 Converts argument to float to avoid large integer problem in elisp. \
  "
  (assert (integerp n) nil  "The function `!' takes integers only")
  (cond 
    ((< n 0) Infinity%)
    ((= 0 n) 1.0)
    (t (* n (! (1- n))))))
  ;
  ; we make the result float to avoid the large integer problem in elisp
  ; The TCL version is better and is in bibliotek.general.gcl


(deff print-to-file (x file &optional overwrite)
  "\
 Prints any object to a file as if by `princ', following it with a newline.  
 If `overwrite' is nonnil it will overwrite the file, rather than appending 
 to it.  The object itself is returned.  \
  "
 ;-----------------------------------------------------
 ;/turn off any inhibitors to printing the whole object
 ;-----------------------------------------------------
  (varbind 
   print-length nil
   print-level nil)
  (declare (special print-length print-level))  
 ;-----------------------------------------------------
 ;/write to file using kludgy feature of `write-region'
 ;-----------------------------------------------------
  (write-region (format "%s\n" x) nil file (not overwrite) 0)
 ;----------------------
 ;/return object printed
 ;----------------------
  x)
 ;
 ; In principle we want this for TCL too, someday.
 ; The "special" declaration stops compiler warnings.


;: Rearranging the names of random number generators for consistency with TCL

; The function `random' exists in both elisp and TCL, but they accept different
; args and return different values.  In addition elisp's cl-package provides
; the function `random*'.  After adjusting the names below, we have two random
; number generators within elisp, both of which follow TCL conventions:
;   Random == random* (provided by cl-package)
;   random-from-elisp (made from el:random)
; We also preserve the original elisp function under a new name:
;   el:random = the new name for elisp's `random'
; (To avoid confusion, we don't use the name `random' at all. We just make it
; give an error.  However, for the sake of other users, we do this only
; "locally".)

(defalias 'Random 'random*)

(unless (fboundp 'el:random) (defalias 'el:random  (symbol-function 'random)))

(when (and (boundp '*user=rds*) *user=rds*)
(deff random (&optional dummy)
  "\
 This is now just a dummy function.  
 Use `Random' or `random-from-elisp' instead.
 Or use `el:random' if you want literally the original elisp version.
  "
  (error "Don't use `random', use `Random' or `random-from-elisp' instead.")))

(deff random-from-elisp (bound &optional (64bit *carefully*))
  "\
 SYNOPSIS (random-from-elisp bound &optional 64bit)
 If `bound' is of type integer then we return a random integer in the
 range [0 bound).  If it a floating point then the range is [0 bound] 
 and the possible values are discrete with a spacing depending on the machine.
 If the optional argument `64bit' is true [defaults to *carefully*] then we
 demand the spacing to be smaller than 1e-12.
 To initialize the seed do (el:random t).
 CAUTION  If you compile this on one machine and run it on another then you
 might get unpredictable results (eg compiling on umoja and running on phonon).
  " 
 ;-------------------
 ;/check bound is > 0
 ;-------------------
  (o assert plusp bound)
 ;------------------------------------------------
 ;/invoke el:random and process result as required
 ;------------------------------------------------
  (cond
   ((integerp bound) (el:random bound))
   ((floatp bound)
   ;---------------------------------------------
   ;/does this machine support the integer 10^12?
   ;---------------------------------------------
    (when 64bit
      (assert (< 1e12 most-positive-fixnum) nil  
	"The integer 10^12 is too big for this machine!")) 
    (varbind  
      fneg (float most-negative-fixnum)
      fpos (float most-positive-fixnum))
    (* bound (ratio (- (el:random) fneg) (- fpos fneg))))))
  ;
  ; NOTES
  ; 
  ; This is concocted from elisp's function `random', which accepts either no
  ; argument or a strictly positive integer.  In the former case it returns a
  ; (positive or negative) integer, in the latter a natural number in the
  ; specified range. It gives garbage if its argument is zero or a float!
  ; Therefore we include check that arg > 0.


;: END