;;; Copyright (c) 2000-2004, 2007 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining a copy
;;; of this software and associated documentation files (the "Software"), to deal
;;; in the Software without restriction, including without limitation the rights
;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;;; copies of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be included in
;;; all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;;; THE SOFTWARE.
;;
(import hashtable)
(require-library "sisc/libs/srfi")
(import srfi-1)
;; (import srfi-4)
(import srfi-9)
(import srfi-13)

;; SISC has no SRFI-4!
;; Provide minimal compatible interface.
(define-record-type <u8vector>
  (make-u8vector* vec)
  u8vector?
  (vec u8vector-vec*))
(define (make-u8vector len . maybe-val) (make-u8vector* (apply make-vector len maybe-val)))
(define (u8vector-set! v i x) (vector-set! (u8vector-vec* v) i x))
(define (u8vector-ref v i) (vector-ref (u8vector-vec* v) i))
(define (u8vector-length v) (vector-length (u8vector-vec* v)))
(define (u8vector->list v) (vector->list (u8vector-vec* v)))

;; Provide compatible hash-table interface over SISC's hashtables.
(define (make-hash-table)
  (make-hashtable eq?))

(define (hash-table-put! ht key value)
  (hashtable/put! ht key value))

(define hash-table-get
  (let ((*default* "*default*"))
    (lambda (ht key default-thunk)
      (let ((v (hashtable/get ht key *default*)))
	(if (eq? v *default*)
	    (default-thunk)
	    v)))))

(define (hash-table-for-each ht f)
  (hashtable/for-each f ht))

;; Load the core code.
(include "../common/ubf.scm")

;; SISC has no sort function! The common encode-ubf-a is useless
;; without one.
(define (encode-ubf-a char-emitter term)
  (basic-encode-ubf-a char-emitter term))