;;; -*-Scheme-*-
;;;
;;; Initialization code for the Elk interpreter kernel.
;;;
;;; This file is loaded on startup before the toplevel (or the file
;;; supplied along with the -l option) is loaded.
;;;
;;; If a garbage collection is triggered while loading this file,
;;; it is regarded as an indication that the heap size is too small
;;; and an error message is printed.


;;; Primitives that are part of the core functionality but are not
;;; implemented in C:

(define (expt b n)
  (define (square x) (* x x))
  (cond ((= n 0) 1)
	((negative? n) (/ 1 (expt b (abs n))))
        ((even? n) (square (expt b (/ n 2))))
        (else (* b (expt b (- n 1))))))


;;; Synonyms:

(define call/cc call-with-current-continuation)


;;; Backwards compatibility:

(define (close-port p)
  (if (input-port? p) (close-input-port p) (close-output-port p)))

(define (re-entrant-continuations?) #t)


;;; Useful macros (these were loaded by the standard toplevel in
;;; earlier versions of Elk).  They shouldn't really be here, but
;;; it's too late...

(define (expand form)
  (if (or (not (pair? form)) (null? form))
      form
      (let ((head (expand (car form))) (args (expand (cdr form))) (result))
	(if (and (symbol? head) (bound? head))
	    (begin
	      (set! result (macro-expand (cons head args)))
	      (if (not (equal? result form))
		  (expand result)
		  result))
	    (cons head args)))))

(define-macro (unwind-protect body . unwind-forms)
  `(dynamic-wind
    (lambda () #f)
    (lambda () ,body)
    (lambda () ,@unwind-forms)))

(define-macro (while test . body)
  `(let loop ()
     (cond (,test ,@body (loop)))))

(define-macro (when test . body)
  `(cond (,test ,@body)))

(define-macro (unless test . body)
  `(when (not ,test) ,@body))

(define-macro (multiple-value-bind vars form . body)
  `(apply (lambda ,vars ,@body) ,form))
