;  Ackermann function -- (ack 4 1) takes a LONG, LONG time!!!
(define (ack m n)
      (cond ((= m 0)  (1+ n))
            ((= n 0)  (ack (-1+ m) 1))
            (else     (ack (-1+ m) (ack m (-1+ n))))))

; Properly tail-recursive factorial function
(define (fact n)
	(define (fact-iter count answer)
		(if (< count 2)
		    answer
		    (fact-iter (-1+ count) (* count answer))))
	(fact-iter n 1))

; Standard(?) Fibonacci sequence function
; Fibonacci sequencer   1 1 2 3 5 8 13 21 34 55 89 . . .
(define (fib n)
    (if (< n 2)
		1
		(+ (fib (- n 2))
		   (fib (- n 1))
		)
	)
)

; Produce a list of integers from MWH˛-IOTA-BASE to n.
; Similar to APL's  iota function.
(define (iota n)
	(define (iota-iter start count answer)
		(if (positive? count)
			(append (list start) (iota-iter (1+ start) (-1+ count) answer))
			answer))
    (iota-iter MWH˛-IOTA-BASE n ())
)
(define MWH˛-IOTA-BASE 1)
(display "MWH˛-IOTA-BASE set to 1")
(newline)

; For the winter -- Wind Chill Index calculator
(define (f->c fahr)
	(- (/ (* (+ fahr 40.0)
			 5.0)
		  9.0)
       40.0)
)
(define (c->f celsius)
	(- (/ (* (+ celsius 40.0)
			 9.0)
		  5.0)
       40.0)
)
(define (wci f-temp mph-wind)
  (define (mph-to-mps mph)
    (* mph
       (/ (* 5280.0 12.0 25.4) (* 3600.0 1000.0))))
  (define (wind-chill-factor c-temp mps-wind)
    (* (+ 10.45
	  (* 10.0 (sqrt mps-wind))
	  (- mps-wind))
       (- 33.0 c-temp)))
  (let* ((metric-4mph (mph-to-mps 4.0))
	 (metric-temp (f->c f-temp))
	 (metric-wind (if (< mph-wind 4.0)
			  metric-4mph
			(mph-to-mps mph-wind)))
	 (my-wcf (wind-chill-factor metric-temp metric-wind))
	 )
    (if (<= mph-wind 45.0)
	(c->f (- 33.0
		 (/ my-wcf
		    (+ 10.45
		       (* 10.0 (sqrt metric-4mph))
		       (- metric-4mph)))))
      (print "Error: Wind speed too high [>45-mph]"))))

(display "Usage: (wci fahrenheit-temp wind-speed-mph)")
(newline)

(define (freesp)
	(let ((mem-usage (gc 0 0)))
		(writeln "Calls to GC:#\		" (car mem-usage))
		(writeln "Nodes:#\			" (cadr mem-usage))
		(writeln "Free nodes:#\		" (caddr mem-usage))
		(writeln "Node segments:#\		" (cadddr mem-usage))
		(writeln "Vector segments:#\	" (car (cddddr mem-usage)))
		(writeln "Heap size:#\		" (cadr (cddddr mem-usage)))
	))