added Banana
This commit is contained in:
Taylor R. Campbell
parent
81d87d51a9
commit
2732d18bba
|
|
@ -0,0 +1 @@
|
|||
Taylor Campbell
|
||||
|
|
@ -0,0 +1 @@
|
|||
banana: http://twistedmatrix.com/documents/specifications/banana.html
|
||||
|
|
@ -0,0 +1,132 @@
|
|||
'Banana' is a simple object serialisation protocol.
|
||||
|
||||
- Main Procedures -
|
||||
|
||||
(encode value [profile]) ==> byte-vector [procedure]
|
||||
Turns a value into a byte-vector representing that value.
|
||||
Generally, the 'none' profile is used (and PROFILE defaults to
|
||||
PROFILE/NONE), and with that one can encode only integers
|
||||
(positive, zero, and negative, and of any size), lists, strings,
|
||||
and reals (*FIXME* Real number encoding and decoding doesn't
|
||||
work right now -- I haven't a clue how to encode them in the
|
||||
IEEE floating point format, which is what Banana requires).
|
||||
Example:
|
||||
(encode '(1 -1 ("hello")))
|
||||
(not printed as byte-vectors would normally print; this is
|
||||
just how Banana output is ordinarily shown)
|
||||
==> 03 80 01 81 01 83 01 80 05 82 68 65 6c 6c 6c 6f
|
||||
|
||||
(decode input-port/string/byte-vector [profile]) [procedure]
|
||||
==> value
|
||||
Decodes the output of ENCODE, or reads similar output from an
|
||||
input port, or processes a string similarly.
|
||||
Example:
|
||||
(decode (encode '(1 -1 ("hello"))))
|
||||
==> (1 -1 ("hello"))
|
||||
|
||||
(etb? byte) [procedure]
|
||||
==> boolean
|
||||
Returns #t if BYTE > 127 (#x7f), #f if otherwise. BYTE must be
|
||||
an exact integer.
|
||||
|
||||
- Exceptions -
|
||||
|
||||
banana-error <-- error [condition type]
|
||||
Subtypes of BANANA-ERROR are raised whenever anything involving
|
||||
Banana-ing goes wrong. The procedure that raised the error is
|
||||
stored in each BANANA-ERROR condition, too, accessed by
|
||||
BANANA-ERROR-CALLER.
|
||||
|
||||
(banana-error? value) [condition type predicate]
|
||||
|
||||
(banana-error-caller banana-error) ==> symbol [procedure]
|
||||
Returns the name of the procedure that raised BANANA-ERROR.
|
||||
|
||||
banana:unknown-byte <-- banana-error [condition type]
|
||||
Raised when DECODE encounters an element type byte (see the
|
||||
Banana specification on http://twistedmatrix.com/ for what the
|
||||
element type bytes are) that it can't find in the profile it was
|
||||
passed.
|
||||
|
||||
(unknown-byte-error? value) [condition type predicate]
|
||||
|
||||
(unknown-byte-error-byte banana:unknown-byte) ==> byte [procedure]
|
||||
Returns the byte that DECODE didn't recognise.
|
||||
|
||||
(unknown-byte-error-profile banana:unknown-byte) [procedure]
|
||||
==> profile
|
||||
Returns the profile that DECODE was searching through.
|
||||
|
||||
banana:unsupported-type <-- banana-error [condition type]
|
||||
Raised when a profile's encoder doesn't know how to Banana a
|
||||
value of a certain type.
|
||||
|
||||
(unsupported-type-error? value) [condition type predicate]
|
||||
|
||||
(unsupported-type-error-type banana:unsupported-type) [procedure]
|
||||
==> string
|
||||
Returns the name of the type that a profile's encoder didn't
|
||||
support.
|
||||
|
||||
(unsupported-type-error-value banana:unsupported-type) [procedure]
|
||||
==> value
|
||||
Returns the value of that type that a profile's encoder didn't
|
||||
support.
|
||||
|
||||
read-eof-error <-- read-error [condition type]
|
||||
Raised when an EOF is reached and was not expected.
|
||||
|
||||
- Profiles -
|
||||
|
||||
Profiles are ways to extend the Banana protocol. See the Banana
|
||||
specification for how they work in Banana.
|
||||
|
||||
:profile [record type]
|
||||
Profiles are stored in instances of this. They have four
|
||||
fields, accessed by similar names --
|
||||
name -- profile-name
|
||||
encoder -- profile-encoder
|
||||
decoder-table -- profile-decoder-table
|
||||
super-profile -- profile-super-profile
|
||||
|
||||
NAME is mainly for debugging purposes.
|
||||
|
||||
ENCODER should be a procedure of one argument and should return
|
||||
a byte vector.
|
||||
|
||||
DECODER-TABLE is a table of element type bytes to procedures of
|
||||
two arguments.
|
||||
|
||||
SUPER-PROFILE is either #f or a profile from which another
|
||||
profile can inherit element type byte decoders and such.
|
||||
|
||||
(make-profile string proc alist) [procedure]
|
||||
Makes a profile, whose name is STRING, whose encoder is PROC,
|
||||
and whose decoder table is a table made from ALIST, which should
|
||||
be a list of pairs, the CAR of each being an element type byte,
|
||||
and the CDR of each being a decoder procedure.
|
||||
|
||||
(extend-profile profile string proc alist) [procedure]
|
||||
The preferred profile constructor, this one allows you to make a
|
||||
profile that inherits behaviour from another profile, but is
|
||||
otherwise just like MAKE-PROFILE.
|
||||
|
||||
The BANANA-EXTRAS package include a couple prettifying procedures
|
||||
and a couple useful procedures should one desire to extend Banana.
|
||||
|
||||
(posint->byte-vector nonnegative-integer) [procedure]
|
||||
The name is slightly misleading, since it also works on zero,
|
||||
but in any case, it returns a byte vector of NONNEGATIVE-INTEGER
|
||||
encoded as the Banana specification states. Note that it does
|
||||
-not- produce a byte vector with the PROFILE/NONE element type
|
||||
byte for nonnegative integers.
|
||||
|
||||
(byte-vector->posint byte-vector) [procedure]
|
||||
The inverse of POSINT->BYTE-VECTOR.
|
||||
|
||||
(prettify-byte byte) [procedure]
|
||||
Makes BYTE look like it normally does when being described in
|
||||
the context of Banana.
|
||||
|
||||
(prettify-byte-vector byte-vector) [procedure]
|
||||
Returns a list of prettified bytes in BYTE-VECTOR.
|
||||
|
|
@ -0,0 +1,402 @@
|
|||
;;; This file is part of the Scheme Untergrund Library.
|
||||
|
||||
;;; Copyright (c) 2003 by Taylor Campbell
|
||||
;;; For copyright information, see the file COPYING which comes with
|
||||
;;; the distribution.
|
||||
|
||||
;;;;;; - Conditions -
|
||||
|
||||
(define-condition-type 'banana-error '(error))
|
||||
(define banana-error? (condition-predicate 'banana-error))
|
||||
;; BANANA-ERROR conditions contain information about who signalled
|
||||
;; them in their CADRs.
|
||||
(define banana-error-caller cadr)
|
||||
|
||||
(define-condition-type 'banana:unknown-byte '(banana-error))
|
||||
(define unknown-byte-error?
|
||||
(condition-predicate 'banana:unknown-byte?))
|
||||
;; See the note about BANANA-ERROR conditions. For that reason,
|
||||
;; and that BANANA:UNKNOWN-BYTE is a subtype of BANANA-ERROR, all
|
||||
;; the information in BANANA:UNKNOWN-BYTE conditions (and all the
|
||||
;; others below BANANA-ERROR) store their own fields in the CDDRs.
|
||||
(define unknown-byte-error-byte caddr)
|
||||
(define unknown-byte-error-profile cadddr)
|
||||
|
||||
(define-condition-type 'banana:unsupported-type '(banana-error))
|
||||
(define unsupported-type-error?
|
||||
(condition-predicate 'banana:unsupported-type))
|
||||
(define unsupported-type-error-type caddr)
|
||||
(define unsupported-type-error-value cadddr)
|
||||
|
||||
(define-condition-type 'read-eof-error '(read-error))
|
||||
(define read-eof-error? (condition-predicate 'read-eof-error))
|
||||
|
||||
;;;;;; - Utility functions. -
|
||||
|
||||
;; Used in NONE-ENCODER/STRING.
|
||||
(define (map-string->byte-vector f s . rest)
|
||||
(let* ((len (string-length s))
|
||||
(new (make-byte-vector len 0)))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i len) new)
|
||||
(byte-vector-set! new i
|
||||
(f (string-ref s i))))))
|
||||
|
||||
;; Used in NONE-ENCODER/LIST.
|
||||
(define (byte-vector-concatentate bvectors)
|
||||
(let* ((len (fold (lambda (bv counter)
|
||||
(+ (byte-vector-length bv) counter))
|
||||
0 bvectors))
|
||||
(new (make-byte-vector len 0)))
|
||||
(let loop1 ((to 0) (bvectors bvectors))
|
||||
(if (null? bvectors)
|
||||
new
|
||||
(let* ((bv (car bvectors))
|
||||
(from-len (byte-vector-length bv)))
|
||||
(let loop2 ((to to) (from 0))
|
||||
(if (= from from-len)
|
||||
(loop1 to (cdr bvectors))
|
||||
(begin
|
||||
(byte-vector-set!
|
||||
new to (byte-vector-ref bv from))
|
||||
(loop2 (+ to 1) (+ from 1))))))))))
|
||||
|
||||
;; Variant of BYTE-VECTOR-CONCATENTATE.
|
||||
(define (byte-vector-append . vecs)
|
||||
(if (null? vecs)
|
||||
;; No need to even bother calling BYTE-VECTOR-CONCATENTATE.
|
||||
(make-byte-vector 0 0)
|
||||
(byte-vector-concatentate vecs)))
|
||||
|
||||
;; Maybe these and the two above should be done using the
|
||||
;; SEQUENCES structures that also come with Sunterlib.
|
||||
(define (byte-vector->string bv)
|
||||
(let* ((len (byte-vector-length bv))
|
||||
(new (make-string len)))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i len) new)
|
||||
(string-set! new i (ascii->char (byte-vector-ref bv i))))))
|
||||
|
||||
(define (string->byte-vector s)
|
||||
(let* ((len (string-length s))
|
||||
(new (make-byte-vector len 0)))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i len) new)
|
||||
(byte-vector-set! new i (char->ascii (string-ref s i))))))
|
||||
|
||||
(define (list->byte-vector l)
|
||||
(let* ((len (length l))
|
||||
(new (make-byte-vector len 0)))
|
||||
(do ((i 0 (+ i 1))
|
||||
(l l (cdr l)))
|
||||
((= i len) new)
|
||||
(byte-vector-set! new i (car l)))))
|
||||
|
||||
;; POSINT->BYTE-VECTOR converts nonnegative integers (the name is
|
||||
;; a tad misleading, but it's easier to write and say than
|
||||
;; NONNEGINT->BYTE-VECTOR or something) to byte vectors as
|
||||
;; specified by the Banana protocol.
|
||||
;;
|
||||
;; Tail-recursive, iterative version.
|
||||
(define (posint->byte-vector int)
|
||||
(do ((int int (arithmetic-shift int -7))
|
||||
(bytes '() (cons (bitwise-and int #x7f) bytes)))
|
||||
((zero? int) (list->byte-vector (reverse bytes)))))
|
||||
|
||||
;; CPS version.
|
||||
; (define (posint->byte-vector int)
|
||||
; (do ((int int (arithmetic-shift int -7))
|
||||
; (k (lambda (x) x)
|
||||
; (lambda (x) (k (cons (bitwise-and int #x7f) x)))))
|
||||
; ((zero? int) (list->byte-vector (k '())))))
|
||||
|
||||
;; Linear-recursive version.
|
||||
; (define (posint->byte-vector int)
|
||||
; (list->byte-vecctor
|
||||
; (let loop ((int int))
|
||||
; (if (zero? int)
|
||||
; bytes
|
||||
; (cons (bitwise-and int #x7f)
|
||||
; (loop (arithmetic-shift int -7)))))))
|
||||
|
||||
;; BYTE-VECTOR->POSINT is just like above but the other way
|
||||
;; around.
|
||||
(define (byte-vector->posint bv)
|
||||
(let ((len (byte-vector-length bv)))
|
||||
(do ((i 0 (+ i 1))
|
||||
(result 0 (+ result (* (byte-vector-ref bv i)
|
||||
(expt 128 i)))))
|
||||
((= i len) result))))
|
||||
|
||||
;; REAL->BYTE-VECTOR and BYTE-VECTOR->REAL just return 0.0 and a
|
||||
;; byte vector of zeros, because I haven't the foggiest idea how
|
||||
;; to implement them correctly.
|
||||
(define (real->byte-vector r)
|
||||
(make-byte-vector 8 0))
|
||||
|
||||
(define (byte-vector->real bv)
|
||||
0.0)
|
||||
|
||||
(define (prettify-byte b)
|
||||
(number->string b 16))
|
||||
|
||||
(define (map-byte-vector->list f bv)
|
||||
(let ((len (byte-vector-length bv)))
|
||||
(do ((i (- len 1) (- i 1))
|
||||
(result '() (cons (f (byte-vector-ref bv i)) result)))
|
||||
((negative? i) result))))
|
||||
|
||||
(define (prettify-byte-vector bv)
|
||||
(map-byte-vector->list prettify-byte bv))
|
||||
|
||||
(define alist->integer-table
|
||||
(let ((make (make-table-maker = abs)))
|
||||
(lambda (alist)
|
||||
(let ((table (make)))
|
||||
(for-each (lambda (key/value)
|
||||
(table-set! table
|
||||
(car key/value)
|
||||
(cdr key/value)))
|
||||
alist)
|
||||
table))))
|
||||
|
||||
;;;;;; Here starts the actual Banana code.
|
||||
|
||||
(define-record-type profile :profile
|
||||
(really-make-profile name encoder decoder-table super-profile)
|
||||
profile?
|
||||
(name profile-name)
|
||||
(encoder profile-encoder)
|
||||
(decoder-table profile-decoder-table)
|
||||
(super-profile profile-super-profile))
|
||||
|
||||
(define (make-profile name encoder decoder-alist)
|
||||
(extend-profile #f name encoder decoder-alist))
|
||||
|
||||
(define (extend-profile super-profile name encoder decoder-alist)
|
||||
(really-make-profile name encoder
|
||||
(alist->integer-table decoder-alist)
|
||||
super-profile))
|
||||
|
||||
;; Why did this ever take a variable number of arguments?
|
||||
; (define extend-profile
|
||||
; (case-lambda
|
||||
; ((super-profile profile)
|
||||
; (really-make-profile (profile-name profile)
|
||||
; (profile-encoder profile)
|
||||
; (profile-decoder-table profile)
|
||||
; super-profile))
|
||||
; ((super-profile name encoder decoder-alist)
|
||||
; (really-make-profile name encoder
|
||||
; (alist->integer-table decoder-alist)
|
||||
; super-profile))))
|
||||
|
||||
;; ETB = Element Type Byte
|
||||
(define (lookup-etb-decoder byte profile)
|
||||
(let loop ((p profile))
|
||||
(if p
|
||||
(or (table-ref (profile-decoder-table p) byte)
|
||||
(loop (profile-super-profile p)))
|
||||
(signal 'banana:unknown-byte
|
||||
'lookup-etb-decoder
|
||||
byte profile))))
|
||||
|
||||
(define none-etb/list #x80)
|
||||
(define none-etb/posint #x81)
|
||||
(define none-etb/string #x82)
|
||||
(define none-etb/negint #x83)
|
||||
(define none-etb/float #x84)
|
||||
(define none-etb/largeposint #x85)
|
||||
(define none-etb/largenegint #x86)
|
||||
|
||||
(define none-etb-v/list (byte-vector none-etb/list))
|
||||
(define none-etb-v/posint (byte-vector none-etb/posint))
|
||||
(define none-etb-v/string (byte-vector none-etb/string))
|
||||
(define none-etb-v/negint (byte-vector none-etb/negint))
|
||||
(define none-etb-v/float (byte-vector none-etb/float))
|
||||
(define none-etb-v/largeposint (byte-vector none-etb/largeposint))
|
||||
(define none-etb-v/largenegint (byte-vector none-etb/largenegint))
|
||||
|
||||
(define none-encoder/list
|
||||
(lambda (lst)
|
||||
(if (null? lst)
|
||||
(byte-vector 0 none-etb/list)
|
||||
(byte-vector-concatentate
|
||||
(append (list (posint->byte-vector (length lst)))
|
||||
(list none-etb-v/list)
|
||||
(map (lambda (x) (encode x profile/none))
|
||||
lst))))))
|
||||
|
||||
(define none-encoder/posint
|
||||
(lambda (int)
|
||||
(byte-vector-append (posint->byte-vector int)
|
||||
none-etb-v/posint)))
|
||||
|
||||
(define none-encoder/string
|
||||
(lambda (str)
|
||||
(byte-vector-append
|
||||
(posint->byte-vector (string-length str))
|
||||
(byte-vector none-etb/string)
|
||||
(map-string->byte-vector char->ascii str))))
|
||||
|
||||
(define none-encoder/negint
|
||||
(lambda (int)
|
||||
(byte-vector-append (posint->byte-vector (- int))
|
||||
none-etb-v/negint)))
|
||||
|
||||
(define none-encoder/float
|
||||
(lambda (float)
|
||||
(byte-vector-append none-etb-v/float
|
||||
(real->byte-vector float))))
|
||||
|
||||
(define none-encoder/largeposint
|
||||
(lambda (int)
|
||||
(byte-vector-append (posint->byte-vector int)
|
||||
none-etb-v/largeposint)))
|
||||
|
||||
(define none-encoder/largenegint
|
||||
(lambda (int)
|
||||
(byte-vector-append (posint->byte-vector (- int))
|
||||
none-etb-v/largenegint)))
|
||||
|
||||
(define none/encode
|
||||
(lambda (obj)
|
||||
(let ((not-supported
|
||||
(lambda (type)
|
||||
(signal 'banana:unsupported-type
|
||||
'none/encode
|
||||
type obj))))
|
||||
((cond
|
||||
((number? obj)
|
||||
(cond
|
||||
((inexact? obj) none-encoder/float)
|
||||
((integer? obj)
|
||||
(if (negative? obj)
|
||||
(if (< obj -2147483648)
|
||||
none-encoder/largenegint
|
||||
none-encoder/negint)
|
||||
(if (> obj 2147483647)
|
||||
none-encoder/largeposint
|
||||
none-encoder/posint)))
|
||||
((rational? obj) (not-supported "rational"))
|
||||
((real? obj) none-encoder/float)
|
||||
((complex? obj) (not-supported "complex"))
|
||||
(else (not-supported "unknown number"))))
|
||||
((list? obj) none-encoder/list)
|
||||
((string? obj) none-encoder/string)
|
||||
(else (not-supported "unknown value")))
|
||||
obj))))
|
||||
|
||||
;; CPS version, if you want it.
|
||||
; (define none-decoder/list
|
||||
; (lambda (bytes inport)
|
||||
; (let loop ((len (byte-vector->posint bytes))
|
||||
; (k (lambda (x) x)))
|
||||
; (if (zero? len)
|
||||
; (k '())
|
||||
; (loop (- len 1)
|
||||
; (lambda (x)
|
||||
; (k (cons (read-element! inport) x))))))))
|
||||
|
||||
;; Linear-recursive version, if you want it.
|
||||
; (define none-decoder/list
|
||||
; (lambda (bytes inport)
|
||||
; (let loop ((len (byte-vector->posint bytes)))
|
||||
; (if (zero? len)
|
||||
; '()
|
||||
; (cons (read-element! inport) (loop (- len 1)))))))
|
||||
|
||||
(define none-decoder/list
|
||||
(lambda (bytes inport)
|
||||
(let loop ((len (byte-vector->posint bytes)) (vals '()))
|
||||
(if (zero? len)
|
||||
(reverse vals)
|
||||
(loop (- len 1) (cons (read-element! inport
|
||||
profile/none)
|
||||
vals))))))
|
||||
|
||||
(define none-decoder/posint
|
||||
(lambda (bytes inport)
|
||||
(byte-vector->posint bytes)))
|
||||
|
||||
(define none-decoder/string
|
||||
(lambda (bytes inport)
|
||||
(let* ((len (byte-vector->posint bytes))
|
||||
(new (make-string len)))
|
||||
(let loop ((i 0))
|
||||
(if (= i len)
|
||||
new
|
||||
(let ((char (read-char inport)))
|
||||
(if (eof-object? char)
|
||||
(signal 'read-eof-error
|
||||
"reached eof"
|
||||
'none-decoder/string
|
||||
inport)
|
||||
(begin
|
||||
(string-set! new i char)
|
||||
(loop (+ i 1))))))))))
|
||||
|
||||
(define none-decoder/negint
|
||||
(lambda (bytes inport)
|
||||
(- (byte-vector->posint bytes))))
|
||||
|
||||
(define none-decoder/float
|
||||
(lambda (bytes inport)
|
||||
(let ((s (make-string 9)))
|
||||
(string-set! s 0 (ascii->char none-etb/float))
|
||||
(do ((i 1 (+ i 1)))
|
||||
((= i 9))
|
||||
(string-set! s i (read-char inport)))
|
||||
(byte-vector->real (string->byte-vector s)))))
|
||||
|
||||
;; NONE-DECODER/POSINT and NONE-DECODER/LARGEPOSINT really do the
|
||||
;; same thing -- the only difference is that they're called in
|
||||
;; difference circumstances.
|
||||
(define none-decoder/largeposint none-decoder/posint)
|
||||
|
||||
;; The same can be said of NONE-DECODER/NEGINT and
|
||||
;; NONE-DECODER/LARGENEGINT.
|
||||
(define none-decoder/largenegint none-decoder/negint)
|
||||
|
||||
(define profile/none
|
||||
(make-profile "none" none/encode
|
||||
`((,none-etb/list . ,none-decoder/list)
|
||||
(,none-etb/posint . ,none-decoder/posint)
|
||||
(,none-etb/string . ,none-decoder/string)
|
||||
(,none-etb/negint . ,none-decoder/negint)
|
||||
(,none-etb/float . ,none-decoder/float)
|
||||
(,none-etb/largeposint . ,none-decoder/largeposint)
|
||||
(,none-etb/largenegint . ,none-decoder/largenegint))))
|
||||
|
||||
(define (etb? b)
|
||||
(> b 127))
|
||||
|
||||
(define (read-element! inport profile)
|
||||
(let loop ((bytes '()))
|
||||
(let ((current-char (read-char inport)))
|
||||
(if (eof-object? current-char)
|
||||
(signal 'read-eof-error
|
||||
"reached EOF"
|
||||
'read-element!
|
||||
inport)
|
||||
(let ((current-byte (char->ascii current-char)))
|
||||
(if (etb? current-byte)
|
||||
((lookup-etb-decoder current-byte profile)
|
||||
(apply byte-vector (reverse bytes))
|
||||
inport)
|
||||
(loop (cons current-byte bytes))))))))
|
||||
|
||||
(define (decode x . profile)
|
||||
(let ((profile (if (pair? profile) (car profile) profile/none)))
|
||||
(cond
|
||||
((input-port? x) (read-element! x profile))
|
||||
((string? x) (read-element! (make-string-input-port x)
|
||||
profile))
|
||||
((byte-vector? x) (decode (byte-vector->string x) profile))
|
||||
(else (error "decode: can't decode from source" x)))))
|
||||
|
||||
(define (encode obj . profile)
|
||||
(let ((f (profile-encoder (if (pair? profile)
|
||||
(car profile)
|
||||
profile/none))))
|
||||
(f obj)))
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
(define-interface banana-interface
|
||||
(export
|
||||
|
||||
(banana-error? (proc (:value) :boolean))
|
||||
|
||||
(unknown-byte-error? (proc (:value) :boolean))
|
||||
(unknown-byte-error-byte (proc (:value) :exact-integer))
|
||||
(unknown-byte-error-profile (proc (:value) :value))
|
||||
|
||||
(unsupported-type-error? (proc (:value) :boolean))
|
||||
(unsupported-type-error-type (proc (:value) :string))
|
||||
(unsupported-type-error-value (proc (:value) :value))
|
||||
|
||||
:profile
|
||||
(make-profile
|
||||
(proc (:string (proc (:value) :value) :pair) :value))
|
||||
(extend-profile
|
||||
(proc (:value :string (proc (:value) :value) :pair) :value))
|
||||
(profile? (proc (:value) :boolean))
|
||||
(profile-name (proc (:value) :string))
|
||||
(profile-encoder (proc (:value)
|
||||
(proc (:value) :value)))
|
||||
(profile-decoder-table (proc (:value) :value))
|
||||
(profile-super-profile (proc (:value) :value))
|
||||
|
||||
profile/none
|
||||
|
||||
;; Do these next two really need to stay here?
|
||||
(etb? (proc (:exact-integer) :boolean))
|
||||
|
||||
(read-element! (proc (:input-port :value) :value))
|
||||
|
||||
(decode (proc (:value &opt :value) :value))
|
||||
(encode (proc (:value &opt :value) :value))))
|
||||
|
||||
(define-interface banana-extras-interface
|
||||
(export
|
||||
|
||||
;; These can be used for other profiles as lengths and such.
|
||||
posint->byte-vector
|
||||
byte-vector->posint
|
||||
|
||||
;; Generally just for debugging or manual testing.
|
||||
prettify-byte
|
||||
prettify-byte-vector))
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
(define-structures ((banana banana-interface)
|
||||
(banana-extras banana-extras-interface))
|
||||
(open scheme
|
||||
define-record-types
|
||||
conditions
|
||||
exceptions
|
||||
signals
|
||||
thread-fluids
|
||||
bitwise
|
||||
tables
|
||||
handle
|
||||
byte-vectors
|
||||
ascii
|
||||
extended-ports
|
||||
srfi-1
|
||||
srfi-2
|
||||
srfi-16)
|
||||
(files banana))
|
||||
Loading…
Reference in New Issue