conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

- bytevector-ieee-[single|double]-[ref|set!] now accept unaligned 

indices (r6rs requirement).
- file-options are now represented as enum-sets (r6rs requirement)
- odd?, even?, lcm, remainder, etc., now accept inexact integers.
This commit is contained in:
Abdulaziz Ghuloum 2008-07-24 18:58:53 -07:00
parent 9085b79b64
commit 7db56cf76e
11 changed files with 248 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.4.prebuilt
View File

Binary file not shown.

BIN
scheme/ikarus.boot.8.prebuilt
View File

Binary file not shown.

181
scheme/ikarus.bytevectors.ss
View File

@ -876,66 +876,177 @@
(die 'bytevector-ieee-single-native-set! "invalid index" i))
(die 'bytevector-ieee-single-native-set! "not a bytevector" bv)))
(define ($bytevector-ieee-double-ref/little x i)
(import (ikarus system $flonums))
(let ([y ($make-flonum)])
($flonum-set! y 0 ($bytevector-u8-ref x i))
($flonum-set! y 1 ($bytevector-u8-ref x ($fx+ i 1)))
($flonum-set! y 2 ($bytevector-u8-ref x ($fx+ i 2)))
($flonum-set! y 3 ($bytevector-u8-ref x ($fx+ i 3)))
($flonum-set! y 4 ($bytevector-u8-ref x ($fx+ i 4)))
($flonum-set! y 5 ($bytevector-u8-ref x ($fx+ i 5)))
($flonum-set! y 6 ($bytevector-u8-ref x ($fx+ i 6)))
($flonum-set! y 7 ($bytevector-u8-ref x ($fx+ i 7)))
y))
(define ($bytevector-ieee-double-set!/little x i y)
(import (ikarus system $flonums))
($bytevector-set! x i ($flonum-u8-ref y 0))
($bytevector-set! x ($fx+ i 1) ($flonum-u8-ref y 1))
($bytevector-set! x ($fx+ i 2) ($flonum-u8-ref y 2))
($bytevector-set! x ($fx+ i 3) ($flonum-u8-ref y 3))
($bytevector-set! x ($fx+ i 4) ($flonum-u8-ref y 4))
($bytevector-set! x ($fx+ i 5) ($flonum-u8-ref y 5))
($bytevector-set! x ($fx+ i 6) ($flonum-u8-ref y 6))
($bytevector-set! x ($fx+ i 7) ($flonum-u8-ref y 7)))
(define ($bytevector-ieee-double-ref/big x i)
(import (ikarus system $flonums))
(let ([y ($make-flonum)])
($flonum-set! y 7 ($bytevector-u8-ref x i))
($flonum-set! y 6 ($bytevector-u8-ref x ($fx+ i 1)))
($flonum-set! y 5 ($bytevector-u8-ref x ($fx+ i 2)))
($flonum-set! y 4 ($bytevector-u8-ref x ($fx+ i 3)))
($flonum-set! y 3 ($bytevector-u8-ref x ($fx+ i 4)))
($flonum-set! y 2 ($bytevector-u8-ref x ($fx+ i 5)))
($flonum-set! y 1 ($bytevector-u8-ref x ($fx+ i 6)))
($flonum-set! y 0 ($bytevector-u8-ref x ($fx+ i 7)))
y))
(define ($bytevector-ieee-double-set!/big x i y)
(import (ikarus system $flonums))
($bytevector-set! x i ($flonum-u8-ref y 7))
($bytevector-set! x ($fx+ i 1) ($flonum-u8-ref y 6))
($bytevector-set! x ($fx+ i 2) ($flonum-u8-ref y 5))
($bytevector-set! x ($fx+ i 3) ($flonum-u8-ref y 4))
($bytevector-set! x ($fx+ i 4) ($flonum-u8-ref y 3))
($bytevector-set! x ($fx+ i 5) ($flonum-u8-ref y 2))
($bytevector-set! x ($fx+ i 6) ($flonum-u8-ref y 1))
($bytevector-set! x ($fx+ i 7) ($flonum-u8-ref y 0)))
(define ($bytevector-ieee-single-ref/little x i)
(let ([bv (make-bytevector 4)])
($bytevector-set! bv 0 ($bytevector-u8-ref x i))
($bytevector-set! bv 1 ($bytevector-u8-ref x ($fx+ i 1)))
($bytevector-set! bv 2 ($bytevector-u8-ref x ($fx+ i 2)))
($bytevector-set! bv 3 ($bytevector-u8-ref x ($fx+ i 3)))
($bytevector-ieee-single-native-ref bv 0)))
(define ($bytevector-ieee-single-ref/big x i)
(let ([bv (make-bytevector 4)])
($bytevector-set! bv 3 ($bytevector-u8-ref x i))
($bytevector-set! bv 2 ($bytevector-u8-ref x ($fx+ i 1)))
($bytevector-set! bv 1 ($bytevector-u8-ref x ($fx+ i 2)))
($bytevector-set! bv 0 ($bytevector-u8-ref x ($fx+ i 3)))
($bytevector-ieee-single-native-ref bv 0)))
(define ($bytevector-ieee-single-set!/little x i v)
(let ([bv (make-bytevector 4)])
($bytevector-ieee-single-native-set! bv 0 v)
($bytevector-set! x i ($bytevector-u8-ref bv 0))
($bytevector-set! x ($fx+ i 1) ($bytevector-u8-ref bv 1))
($bytevector-set! x ($fx+ i 2) ($bytevector-u8-ref bv 2))
($bytevector-set! x ($fx+ i 3) ($bytevector-u8-ref bv 3))))
(define ($bytevector-ieee-single-set!/big x i v)
(let ([bv (make-bytevector 4)])
($bytevector-ieee-single-native-set! bv 0 v)
($bytevector-set! x i ($bytevector-u8-ref bv 3))
($bytevector-set! x ($fx+ i 1) ($bytevector-u8-ref bv 2))
($bytevector-set! x ($fx+ i 2) ($bytevector-u8-ref bv 1))
($bytevector-set! x ($fx+ i 3) ($bytevector-u8-ref bv 0))))
(define (bytevector-ieee-double-ref bv i endianness)
(define who 'bytevector-ieee-double-ref)
(if (bytevector? bv)
(if (and (fixnum? i)
($fx>= i 0)
($fxzero? ($fxlogand i 7))
($fx< i ($bytevector-length bv)))
(if (and (fixnum? i) ($fx>= i 0))
(let ([len ($bytevector-length bv)])
(if (and ($fxzero? ($fxlogand i 7)) ($fx< i len))
(case endianness
[(little) ($bytevector-ieee-double-native-ref bv i)]
[(big) ($bytevector-ieee-double-nonnative-ref bv i)]
[else (die 'bytevector-ieee-double-ref
"invalid endianness" endianness)])
(die 'bytevector-ieee-double-ref "invalid index" i))
(die 'bytevector-ieee-double-ref "not a bytevector" bv)))
[else (die who "invalid endianness" endianness)])
(if ($fx<= i ($fx- len 8))
(case endianness
[(little)
($bytevector-ieee-double-ref/little bv i)]
[(big)
($bytevector-ieee-double-ref/big bv i)]
[else (die who "invalid endianness" endianness)])
(die who "invalid index" i))))
(die who "invalid index" i))
(die who "not a bytevector" bv)))
(define (bytevector-ieee-single-ref bv i endianness)
(define who 'bytevector-ieee-single-ref)
(if (bytevector? bv)
(if (and (fixnum? i)
($fx>= i 0)
($fxzero? ($fxlogand i 3))
($fx< i ($bytevector-length bv)))
(if (and (fixnum? i) ($fx>= i 0))
(let ([len ($bytevector-length bv)])
(if (and ($fxzero? ($fxlogand i 3)) ($fx< i len))
(case endianness
[(little) ($bytevector-ieee-single-native-ref bv i)]
[(big) ($bytevector-ieee-single-nonnative-ref bv i)]
[else (die 'bytevector-ieee-single-ref
"invalid endianness" endianness)])
(die 'bytevector-ieee-single-ref "invalid index" i))
(die 'bytevector-ieee-single-ref "not a bytevector" bv)))
[else (die who "invalid endianness" endianness)])
(if ($fx<= i ($fx- len 4))
(case endianness
[(little)
($bytevector-ieee-single-ref/little bv i)]
[(big)
($bytevector-ieee-single-ref/big bv i)]
[else (die who "invalid endianness" endianness)])
(die who "invalid index" i))))
(die who "invalid index" i))
(die who "not a bytevector" bv)))
(define (bytevector-ieee-double-set! bv i x endianness)
(define who 'bytevector-ieee-double-set!)
(if (bytevector? bv)
(if (and (fixnum? i)
($fx>= i 0)
($fxzero? ($fxlogand i 7))
($fx< i ($bytevector-length bv)))
(if (flonum? x)
(if (and (fixnum? i) ($fx>= i 0))
(let ([len ($bytevector-length bv)])
(if (and ($fxzero? ($fxlogand i 7)) ($fx< i len))
(case endianness
[(little) ($bytevector-ieee-double-native-set! bv i x)]
[(big) ($bytevector-ieee-double-nonnative-set! bv i x)]
[else (die 'bytevector-ieee-double-set!
"invalid endianness" endianness)])
(die 'bytevector-ieee-double-set! "not a flonum" x))
(die 'bytevector-ieee-double-set! "invalid index" i))
(die 'bytevector-ieee-double-set! "not a bytevector" bv)))
[else
(die who "invalid endianness" endianness)])
(if ($fx<= i ($fx- len 8))
(case endianness
[(little)
($bytevector-ieee-double-set!/little bv i x)]
[(big)
($bytevector-ieee-double-set!/big bv i x)]
[else
(die who "invalid endianness" endianness)])
(die who "invalid index" i))))
(die who "invalid index" i))
(die who "not a flonum" x))
(die who "not a bytevector" bv)))
(define (bytevector-ieee-single-set! bv i x endianness)
(define who 'bytevector-ieee-single-set!)
(if (bytevector? bv)
(if (and (fixnum? i)
($fx>= i 0)
($fxzero? ($fxlogand i 3))
($fx< i ($bytevector-length bv)))
(if (flonum? x)
(if (and (fixnum? i) ($fx>= i 0))
(let ([len ($bytevector-length bv)])
(if (and ($fxzero? ($fxlogand i 3)) ($fx< i len))
(case endianness
[(little) ($bytevector-ieee-single-native-set! bv i x)]
[(big) ($bytevector-ieee-single-nonnative-set! bv i x)]
[else (die 'bytevector-ieee-single-set!
"invalid endianness" endianness)])
(die 'bytevector-ieee-single-set! "not a flonum" x))
(die 'bytevector-ieee-single-set! "invalid index" i))
(die 'bytevector-ieee-single-set! "not a bytevector" bv)))
[else
(die who "invalid endianness" endianness)])
(if ($fx<= i ($fx- len 4))
(case endianness
[(little)
($bytevector-ieee-single-set!/little bv i x)]
[(big)
($bytevector-ieee-single-set!/big bv i x)]
[else
(die who "invalid endianness" endianness)])
(die who "invalid index" i))))
(die who "invalid index" i))
(die who "not a flonum" x))
(die who "not a bytevector" bv)))
(define ($bytevector-ref/64 bv i who decoder endianness)
(if (bytevector? bv)

31
scheme/ikarus.codecs.ss
View File

@ -17,12 +17,12 @@
(library (ikarus codecs)
(export latin-1-codec utf-8-codec utf-16-codec native-eol-style
make-transcoder native-transcoder buffer-mode?
file-options-spec transcoder-codec transcoder-eol-style
transcoder-codec transcoder-eol-style
transcoder-error-handling-mode)
(import
(except (ikarus) latin-1-codec utf-8-codec utf-16-codec
native-eol-style make-transcoder native-transcoder
buffer-mode? file-options-spec transcoder-codec
buffer-mode? transcoder-codec
transcoder-eol-style transcoder-error-handling-mode)
(ikarus system $transcoders))
(define (latin-1-codec) 'latin-1-codec)
@ -116,32 +116,5 @@
(define (buffer-mode? x)
(and (memq x '(none line block)) #t))
(define file-options-vec
'#(fo:default
fo:no-create
fo:no-fail
fo:no-fail/no-create
fo:no-truncate
fo:no-truncate/no-create
fo:no-truncate/no-fail
fo:no-truncate/no-fail/no-create))
(define file-options-alist
'([no-create . #b001]
[no-fail . #b010]
[no-truncate . #b100]))
(define (file-options-spec ls)
(unless (list? ls)
(die 'file-options-spec "not a list" ls))
(let f ([ls ls] [n 0])
(cond
[(null? ls) (vector-ref file-options-vec n)]
[(assq (car ls) file-options-alist) =>
(lambda (a)
(f (cdr ls) (fxlogor (cdr a) n)))]
[else #f])))
)

12
scheme/ikarus.enumerations.ss
View File

@ -17,14 +17,16 @@
(export make-enumeration enum-set-universe enum-set-indexer
enum-set-constructor enum-set->list enum-set-member?
enum-set-subset? enum-set=? enum-set-union enum-set-difference
enum-set-intersection enum-set-complement enum-set-projection)
enum-set-intersection enum-set-complement enum-set-projection
make-file-options)
(import
(except (ikarus)
make-enumeration enum-set-universe enum-set-indexer
enum-set-constructor enum-set->list enum-set-member?
enum-set-subset? enum-set=? enum-set-union enum-set-difference
enum-set-intersection enum-set-complement
enum-set-projection))
enum-set-projection
make-file-options))
(define-record-type enum
(fields g univ values)
@ -217,6 +219,12 @@
(make-enum g u (combine u s))))))
(die 'enum-set-projection "not an enumeration" x2))
(die 'enum-set-projection "not an enumeration" x1)))
(define make-file-options
(enum-set-constructor
(make-enumeration
'(no-create no-fail no-truncate))))
)
#!eof

16
scheme/ikarus.io.ss
View File

@ -1376,16 +1376,12 @@
[else fh])))
(define (open-output-file-handle filename file-options who)
(let ([opt (case file-options
[(fo:default) 0]
[(fo:no-create) 1]
[(fo:no-fail) 2]
[(fo:no-fail/no-create) 3]
[(fo:no-truncate) 4]
[(fo:no-truncate/no-create) 5]
[(fo:no-truncate/no-fail) 6]
[(fo:no-truncate/no-fail/no-create) 7]
[else (die who "invalid file option" file-options)])])
(define (opt->num x)
(bitwise-ior
(if (enum-set-member? 'no-create x) 1 0)
(if (enum-set-member? 'no-fail x) 2 0)
(if (enum-set-member? 'no-truncate x) 4 0)))
(let ([opt (opt->num file-options)])
(let ([fh (foreign-call "ikrt_open_output_fd"
(string->utf8 filename)
opt)])

122
scheme/ikarus.numerics.ss
View File

@ -14,7 +14,7 @@
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(library (ikarus flonums)
(export $flonum->exact $flonum->integer flonum-parts
(export $flonum->exact flonum-parts
inexact->exact exact $flonum-rational? $flonum-integer? $flzero?
$flnegative? flpositive? flabs fixnum->flonum
flsin flcos fltan flasin flacos flatan fleven? flodd?
@ -103,7 +103,7 @@
($flround x)
(die 'flround "not a flonum" x)))
(module ($flonum->integer $flonum->exact)
(module ($flonum->exact)
(define ($flonum-signed-mantissa x)
(let ([b0 ($flonum-u8-ref x 0)])
(let ([m0 ($fx+ ($flonum-u8-ref x 7)
@ -122,33 +122,6 @@
(+ (bitwise-arithmetic-shift-left
($fx- 0 ($fxlogor m1 ($fxsll m2 24))) 24)
($fx- 0 m0))))))
(define ($flonum->integer x)
(let ([sbe ($flonum-sbe x)])
(let ([be ($fxlogand sbe #x7FF)])
(cond
[($fx= be 2047) #f] ;;; nans/infs
[($fx>= be 1075) ;;; magnitude large enough to be an integer
(bitwise-arithmetic-shift-left
($flonum-signed-mantissa x)
(- be 1075))]
[else
(let-values ([(pos? be m) (flonum-parts x)])
(cond
[(<= 1 be 2046) ; normalized flonum
(let ([n (+ m (expt 2 52))]
[d (expt 2 (- be 1075))])
(let-values ([(q r) (quotient+remainder n d)])
(if (= r 0)
(if pos? q (- q))
#f)))]
[(= be 0) (if (= m 0) 0 #f)]
[else #f]))]))))
(define-syntax ctexpt
(lambda (x)
(import (ikarus))
(syntax-case x ()
[(_ n m)
(expt (syntax->datum #'n) (syntax->datum #'m))])))
(define ($flonum->exact x)
(import (ikarus))
(let ([sbe ($flonum-sbe x)])
@ -167,9 +140,9 @@
(if (= m 0)
0
(* (if pos? 1 -1)
(/ m (ctexpt 2 1074))))]
(/ m (expt 2 1074))))]
[else ; normalized flonum
(/ (+ m (ctexpt 2 52))
(/ (+ m (expt 2 52))
(bitwise-arithmetic-shift-left
(if pos? 1 -1)
(- 1075 be)))]))])))))
@ -413,7 +386,7 @@
(ikarus system $chars)
(ikarus system $strings)
(only (ikarus flonums) $flonum->exact $flzero? $flnegative?
$flonum->integer $flround)
$flround)
(except (ikarus) + - * / zero? = < <= > >= add1 sub1 quotient
remainder modulo even? odd? quotient+remainder number->string
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left
@ -1101,23 +1074,35 @@
[y (if (< y 0) (- y) y)])
(let ([g (binary-gcd x y)])
(binary* y (quotient x g))))]
[(number? y)
(die 'lcm "not an exact integer" y)]
[(flonum? y)
(let ([v ($flonum->exact y)])
(cond
[(or (fixnum? v) (bignum? v))
(inexact (lcm x v))]
[else (die 'lcm "not an integer" y)]))]
[else
(die 'lcm "not a number" y)])]
[(number? x)
(die 'lcm "not an exact integer" x)]
(die 'lcm "not an integer" y)])]
[(flonum? x)
(let ([v ($flonum->exact x)])
(cond
[(or (fixnum? v) (bignum? v))
(inexact (lcm v y))]
[else (die 'lcm "not an integer" x)]))]
[else
(die 'lcm "not a number" x)])]
(die 'lcm "not an integer" x)])]
[(x)
(cond
[(or (fixnum? x) (bignum? x)) x]
[(number? x)
(die 'lcm "not an exact integer" x)]
[(flonum? x)
(let ([v ($flonum->exact x)])
(cond
[(or (fixnum? v) (bignum? v)) x]
[else (die 'lcm "not an integer" x)]))]
[else
(die 'lcm "not a number" x)])]
(die 'lcm "not an integer" x)])]
[() 1]
[(x y z . ls)
;;; FIXME: incorrect for multiple roundings
(let f ([g (lcm (lcm x y) z)] [ls ls])
(cond
[(null? ls) g]
@ -1529,16 +1514,25 @@
(cond
[(fixnum? x) ($fxeven? x)]
[(bignum? x) (even-bignum? x)]
[(flonum? x) (die 'even? "BUG" x)]
[(flonum? x)
(let ([v ($flonum->exact x)])
(cond
[(fixnum? v) ($fxeven? v)]
[(bignum? v) (even-bignum? v)]
[else (die 'even? "not an integer" x)]))]
[else (die 'even? "not an integer" x)]))
(define (odd? x)
(not
(cond
[(fixnum? x) ($fxeven? x)]
[(bignum? x) (even-bignum? x)]
[(flonum? x) (die 'odd? "BUG" x)]
[else (die 'odd? "not an integer" x)])))
[(fixnum? x) (not ($fxeven? x))]
[(bignum? x) (not (even-bignum? x))]
[(flonum? x)
(let ([v ($flonum->exact x)])
(cond
[(fixnum? v) (not ($fxeven? v))]
[(bignum? v) (not (even-bignum? v))]
[else (die 'odd? "not an integer" x)]))]
[else (die 'odd? "not an integer" x)]))
(module (number->string)
(module (bignum->string)
@ -1660,9 +1654,10 @@
n
(foreign-call "ikrt_fxbnplus" n m)))]
[(flonum? m)
(let ([v ($flonum->integer m)])
(let ([v ($flonum->exact m)])
(cond
[v (inexact (modulo n v))]
[(or (fixnum? v) (bignum? v))
(inexact (modulo n v))]
[else
(die 'modulo "not an integer" m)]))]
[(ratnum? m) (die 'modulo "not an integer" m)]
@ -1680,17 +1675,19 @@
(+ m (remainder n m))
(remainder n m)))]
[(flonum? m)
(let ([v ($flonum->integer m)])
(let ([v ($flonum->exact m)])
(cond
[v (inexact (modulo n v))]
[(or (fixnum? v) (bignum? v))
(inexact (modulo n v))]
[else
(die 'modulo "not an integer" m)]))]
[(ratnum? m) (die 'modulo "not an integer" m)]
[else (die 'modulo "not a number" m)])]
[(flonum? n)
(let ([v ($flonum->integer n)])
(let ([v ($flonum->exact n)])
(cond
[v (inexact (modulo v m))]
[(or (fixnum? v) (bignum? v))
(inexact (modulo v m))]
[else
(die 'modulo "not an integer" n)]))]
[(ratnum? n) (die 'modulo "not an integer" n)]
@ -2385,9 +2382,11 @@
[(flonum? m) (flexpt (inexact n) m)]
[(ratnum? m) (flexpt (inexact n) (inexact m))]
[(or (compnum? m) (cflonum? m))
(if (eq? n 0)
0
(let ([e 2.718281828459045])
(define (ln x) (/ (log x) (log e)))
(exp (* m (ln n))))]
(exp (* m (ln n)))))]
[else (die 'expt "not a number" m)])))
(define quotient
@ -2413,9 +2412,9 @@
(fxremainder x y))]
[(bignum? y) (values 0 x)]
[(flonum? y)
(let ([v ($flonum->integer y)])
(let ([v ($flonum->exact y)])
(cond
[v
[(or (fixnum? v) (bignum? v))
(let-values ([(q r) (quotient+remainder x v)])
(values (inexact q) (inexact r)))]
[else
@ -2430,18 +2429,18 @@
(let ([p (foreign-call "ikrt_bnbndivrem" x y)])
(values (car p) (cdr p)))]
[(flonum? y)
(let ([v ($flonum->integer y)])
(let ([v ($flonum->exact y)])
(cond
[v
[(or (fixnum? v) (bignum? v))
(let-values ([(q r) (quotient+remainder x v)])
(values (inexact q) (inexact r)))]
[else
(die 'quotient+remainder "not an integer" y)]))]
[else (die 'quotient+remainder "not a number" y)])]
[(flonum? x)
(let ([v ($flonum->integer x)])
(let ([v ($flonum->exact x)])
(cond
[v
[(or (fixnum? v) (bignum? v))
(let-values ([(q r) (quotient+remainder v y)])
(values (inexact q) (inexact r)))]
[else (die 'quotient+remainder "not an integer" x)]))]
@ -2695,8 +2694,7 @@
;;;
(cond
[(flonum? x)
(let ([e (or ($flonum->exact x)
(die 'truncate "number has no real value" x))])
(let ([e ($flonum->exact x)])
(cond
[(ratnum? e) (exact->inexact ($ratnum-truncate e))]
[else x]))]

2
scheme/last-revision
View File

@ -1 +1 @@
1550
1551

2
scheme/makefile.ss
View File

@ -1333,7 +1333,7 @@
[syntax-error i]
[$transcoder->data $transc]
[$data->transcoder $transc]
[file-options-spec i]
[make-file-options i]
;;;
[port-id i]
[read-annotated i]

2
scheme/psyntax.compat.ss
View File

@ -17,7 +17,7 @@
(library (psyntax compat)
(export define-record make-parameter parameterize format gensym
eval-core symbol-value set-symbol-value!
file-options-spec make-struct-type read-annotated
make-struct-type read-annotated
annotation? annotation-expression annotation-source
annotation-stripped
read-library-source-file)

6
scheme/psyntax.expander.ss
View File

@ -2599,10 +2599,12 @@
(define file-options-macro
(lambda (x)
(define (valid-option? x)
(and (id? x) (memq (id->sym x) '(no-fail no-create no-truncate))))
(syntax-match x ()
((_ opt* ...)
(and (for-all id? opt*) (file-options-spec (map id->sym opt*)))
(bless `(quote ,(file-options-spec (map id->sym opt*))))))))
(for-all valid-option? opt*)
(bless `(make-file-options ',opt*))))))
(define symbol-macro
(lambda (x set)