;;; $Id: libguile.scm,v 1.3 1995/01/07 21:44:14 miles Exp $
;;; ----------------------------------------------------------------
;;; libguile.scm -- Basic guile interfaces
;;; 21 Dec 1994, Miles Bader <miles@eskimo.com>
;;; ----------------------------------------------------------------
;;;

(in-package GUILE)

(export-library GUILE
 (GUILE SCHEME R4RS MODULE VARIABLE GUILE-INTERNALS SLIB-HOOKS
  VICINITY RECORD TIME DEFMACRO SCM-ERRORS SCM-TIMERERS SCM))
(export-library SCHEME
 (SCHEME SCM R4RS GUILE))

;; ----------------------------------------------------------------
(in-module GUILE)

;; The standard guile definitions
;;
(export-interface SCHEME
 (;; syntax
  quote quasiquote unquote unquote-splicing
  lambda and or if cond case define set! let let* letrec begin do 
  ;; test
  not boolean? eq? eqv? equal?
  ;; lists
  pair? cons car cdr set-car! set-cdr!
  caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar
  caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar
  cdaddr cddaar cddadr cdddar cddddr
  null? list? list length append reverse list-ref memq memv member assq assv
  assoc
  ;; symbols
  symbol? symbol->string string->symbol
  ;; numbers
  number? complex? real? rational? integer? exact? inexact? = < > <= >= zero?
  positive? negative? odd? even? max min + * - / abs quotient remainder
  modulo gcd lcm numerator denominator floor ceiling truncate round
  rationalize exp log sin cos tan asin acos atan sqrt expt make-rectangular
  make-polar real-part imag-part magnitude angle exact->inexact
  inexact->exact number->string string->number
  ;; characters
  char? char=? char-ci=? char<? char-ci<? char>? char-ci>? char<=? char-ci<=?
  char>=? char-ci>=? char-alphabetic? char-numeric? char-whitespace?
  char-upper-case? char-lower-case? char->integer integer->char char-upcase
  char-downcase
  ;; strings
  string? make-string string string-length string-ref string-set! string=?
  string-ci=? string<? string-ci<? string>? string-ci>? string<=?
  string-ci<=? string>=? string-ci>=? substring string-append
  ;; vectors
  vector? make-vector vector vector-length vector-ref vector-set!
  ;; procs
  procedure? apply map for-each call-with-current-continuation 
  ;; files
  call-with-input-file call-with-output-file input-port? output-port?
  current-input-port current-output-port open-input-file open-output-file
  close-input-port close-output-port eof-object? read read-char peek-char
  write display newline write-char 
  ))

(export-interface R4RS
 (list-tail string->list list->string string-copy string-fill! vector->list
  list->vector vector-fill! delay force with-input-from-file
  with-output-to-file char-ready? load transcript-on transcript-off
  define-syntax let-syntax letrec-syntax)
 ;; + base scheme
 SCHEME)

(export-interface EXTRAS
 (output-port-width output-port-height current-error-port
  file-exists? delete-file force-output char-code-limit most-positive-fixnum
  identity gentemp 1+ -1+ 1-
  call-with-input-string call-with-output-string
  program-arguments getenv acons copy-tree
  eval dynamic-wind try-load append!
  software-type scheme-implementation-version scheme-implementation-type))

(export-interface GUILE
 (define-macro delq!
  quit restart abort verbose gc room terms
  error system exec)
 EXTRAS
 R4RS)

;; ----------------------------------------------------------------

;; More tricky stuff...
;;
(export-interface GUILE-INTERNALS
 (*top-level-lookup-thunk*
  *load-module* try-load-in-current-module))

(export-interface VARIABLE
 (make-variable make-undefined-variable
  variable-ref variable-set! variable-bound?))

;; ----------------------------------------------------------------

(export-interface SLIB-HOOKS
 (*features*
  slib:load-source slib:load slib:eval-load
  slib:exit slib:error slib:tab slib:form-feed slib:eval
  defmacro:load defmacro:eval
  tmpnam))

(export-interface TIME
 (current-time difftime offset-time))

(export-interface VICINITY
 (in-vicinity
  implementation-vicinity library-vicinity program-vicinity))

(export-interface RECORD
 (make-record-type record-constructor record-predicate record-accessor
  record-modifier))

(export-interface DEFMACRO
 (defmacro macroexpand macroexpand-1))

;; ----------------------------------------------------------------
;; Somewhat icky scm interfaces some of these are user-defined things;
;; unfortunately, the module systems means that the system won't see these if
;; (define ...) is used, so we need some other interface for them.  there
;; needs to to be a real exception system anyway...

(export-interface SCM-TIMERS
 (ticks alarm
  ticks-interrupt user-interrupt alarm-interrupt))

(export-interface SCM-ERRORS
 (errno perror
  ;; The following are user-defined things; unfortunately, the module systems
  ;; means that the system won't see these if (define ...) is used, so we
  ;; need some other interface for them.  there needs to to be a real
  ;; exception system anyway...
  out-of-storage could-not-open end-of-program hang-up arithmetic-error))

(export-interface SCM
 (quit restart error errobj abort
  verbose gc room terms list-file system exec
  tmpnam *scm-version*)
 ;; + other stuff
 DEFMACRO
 VICINITY
 TIME
 RECORD
 SLIB-HOOKS
 SCM-ERRORS
 SCM-TIMERS
 EXTRAS
 R4RS)

;; ----------------------------------------------------------------

(use-interface module)			; do more complex module operations

;; ----------------------------------------------------------------
;; More guile module support stuff

;; *LOAD-MODULE* -- exported
;;
;; This should be either a module, which will be current module when a file
;; is loaded, or a procedure which when called (with arguments ???) will
;; return a module to use.
;; 
(define *load-module*
  ;; start out with the `default/default' module.
  (find-module 'default
	       (find-module 'default *root-package* make-package)
	       make-user-module))
	       
(define try-load-in-current-module try-load)
;; Redefine try-load to bind the current module to *load-module* during loading
;; (try-load is called by load)
(define (try-load file)
  (let ((old-module (current-module)))
    (dynamic-wind (lambda () (set-current-module *load-module*))
		  (lambda () (try-load-in-current-module file))
		  (lambda () (set-current-module old-module)))))
