mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

tweak

Browse Source
main
Matthew Butterick 7 years ago
parent 205582b782
commit c125c7dcbc
6 changed files with 136 additions and 81 deletions
Show Stats Download Patch File Download Diff File

44
pitfall/restructure/private/base.rkt
Unescape Escape View File

@ -1,12 +1,50 @@
#lang racket/base #lang racket/base
(require racket/class sugar/class) (require racket/class sugar/class racket/generic racket/private/generic-methods)
(provide (all-defined-out)) (provide (all-defined-out))
(define-subclass object% (RestructureBase) (define-generics encodable
(decode encodable stream [parent])
(encode encodable stream [val] [parent]))
(define encodable<%>
(interface* ()
([(generic-property gen:encodable)
(generic-method-table gen:encodable
(define (decode o stream [parent #f]) (send o decode stream parent))
(define (encode o stream [val #f] [parent #f]) (send o encode stream val parent)))])))
(define-generics sizable
(size sizable [val] [parent]))
(define sizable<%>
(interface* ()
([(generic-property gen:sizable)
(generic-method-table gen:sizable
(define (size o [val #f] [parent #f]) (send o size val parent)))])))
(define-generics dumpable
(dump dumpable))
(define dumpable<%>
(interface* ()
([(generic-property gen:dumpable)
(generic-method-table gen:dumpable
(define (dump o) (send o dump)))])))
(define RestructureBase
(class* object% (encodable<%> sizable<%> dumpable<%>)
(super-new)
(field [_hash (make-hash)] (field [_hash (make-hash)]
[_list null]) [_list null])
(define/public (decode stream . args) (void)) (define/public (decode stream . args) (void))
(define/public (encode . xs) (void)) (define/public (encode . xs) (void))
(define/public (size . xs) (void)) (define/public (size . xs) (void))
(define/public (process . args) (void)) (define/public (process . args) (void))
(define/public (preEncode . args) (void))) (define/public (preEncode . args) (void))
(define/public (dump) (void))))
(define-class-predicates RestructureBase)

81
pitfall/restructure/private/stream.rkt
Unescape Escape View File

@ -21,39 +21,43 @@ https://github.com/mbutterick/restructure/blob/master/src/EncodeStream.coffee
|# |#
;; basically just a wrapper for a Racket output port ;; basically just a wrapper for a Racket output port
(define-subclass* PortWrapper (EncodeStream [maybe-output-port (open-output-bytes)]) (define EncodeStream
(class* PortWrapper (dumpable<%>)
(init-field [[maybe-output-port maybe-output-port] (open-output-bytes)])
(unless (output-port? maybe-output-port) (unless (output-port? maybe-output-port)
(raise-argument-error 'EncodeStream:constructor "output port" maybe-output-port)) (raise-argument-error 'EncodeStream:constructor "output port" maybe-output-port))
(super-make-object maybe-output-port) (super-make-object maybe-output-port)
(inherit-field _port) (inherit-field _port)
(define/override-final (dump) (get-output-bytes _port)) (define/override-final (dump) (get-output-bytes _port))
(define/public-final (write val) (define/public-final (write val)
(unless (bytes? val) (unless (bytes? val)
(raise-argument-error 'EncodeStream:write "bytes" val)) (raise-argument-error 'EncodeStream:write "bytes" val))
(write-bytes val _port) (write-bytes val _port)
(void)) (void))
(define/public-final (writeBuffer buffer) (define/public-final (writeBuffer buffer)
(write buffer)) (write buffer))
(define/public-final (writeUInt8 int) (define/public-final (writeUInt8 int)
(write (bytes int))) (write (bytes int)))
(define/public (writeString string [encoding 'ascii]) (define/public (writeString string [encoding 'ascii])
;; todo: handle encodings correctly. ;; todo: handle encodings correctly.
;; right now just utf8 and ascii are correct ;; right now just utf8 and ascii are correct
(caseq encoding (caseq encoding
[(utf16le ucs2 utf8 ascii) (writeBuffer (string->bytes/utf-8 string)) [(utf16le ucs2 utf8 ascii) (writeBuffer (string->bytes/utf-8 string))
(when (eq? encoding 'utf16le) (when (eq? encoding 'utf16le)
(error 'swap-bytes-unimplemented))] (error 'swap-bytes-unimplemented))]
[else (error 'unsupported-string-encoding)])) [else (error 'unsupported-string-encoding)]))
(define/public (fill val len) (define/public (fill val len)
(write (make-bytes len val)))) (write (make-bytes len val)))))
(define-class-predicates EncodeStream)
(test-module (test-module
(define es (+EncodeStream)) (define es (+EncodeStream))
@ -69,12 +73,12 @@ https://github.com/mbutterick/restructure/blob/master/src/EncodeStream.coffee
(define op (open-output-bytes)) (define op (open-output-bytes))
(define es2 (+EncodeStream op)) (define es2 (+EncodeStream op))
(send es2 write #"FOOBAR") (send es2 write #"FOOBAR")
(check-equal? (send es2 dump) #"FOOBAR") (check-equal? (dump es2) #"FOOBAR")
(check-equal? (send es2 dump) #"FOOBAR") ; dump can repeat (check-equal? (dump es2) #"FOOBAR") ; dump can repeat
(check-equal? (get-output-bytes op) #"FOOBAR") (check-equal? (get-output-bytes op) #"FOOBAR")
(define es3 (+EncodeStream)) (define es3 (+EncodeStream))
(send es3 fill 0 10) (send es3 fill 0 10)
(check-equal? (send es3 dump) (make-bytes 10 0))) (check-equal? (dump es3) (make-bytes 10 0)))
#| approximates #| approximates
@ -98,7 +102,7 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
(define DecodeStreamT (define DecodeStreamT
(class* PortWrapper (class* PortWrapper
(countable<%>) (encodable<%> dumpable<%> countable<%>)
(init-field [buffer #""]) (init-field [buffer #""])
(unless (bytes? buffer) ; corresponds to a Node Buffer, not a restructure BufferT object (unless (bytes? buffer) ; corresponds to a Node Buffer, not a restructure BufferT object
(raise-argument-error 'DecodeStream:constructor "bytes" buffer)) (raise-argument-error 'DecodeStream:constructor "bytes" buffer))
@ -161,16 +165,17 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
(set-port-position! _port current-position) (set-port-position! _port current-position)
bs))) bs)))
(define-subclass DecodeStreamT (DecodeStream)) (define-subclass DecodeStreamT (DecodeStream))
(test-module (test-module
(define ds (+DecodeStream #"ABCD")) (define ds (+DecodeStream #"ABCD"))
(check-true (DecodeStream? ds)) (check-true (DecodeStream? ds))
(check-equal? (length ds) 4) (check-equal? (length ds) 4)
(check-equal? (send ds dump) #"ABCD") (check-equal? (dump ds) #"ABCD")
(check-equal? (send ds dump) #"ABCD") ; dump can repeat (check-equal? (dump ds) #"ABCD") ; dump can repeat
(check-equal? (send ds readUInt16BE) 16706) (check-equal? (send ds readUInt16BE) 16706)
(check-equal? (send ds dump) #"ABCD") (check-equal? (dump ds) #"ABCD")
(check-equal? (· ds pos) 2) (check-equal? (· ds pos) 2)
(check-equal? (send ds readUInt8) 67) (check-equal? (send ds readUInt8) 67)
(check-equal? (· ds pos) 3) (check-equal? (· ds pos) 3)
@ -203,13 +208,13 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
(test-module (test-module
(define-subclass Streamcoder (Dummy) (define-subclass Streamcoder (Dummy)
(define/augment (decode stream . args) "foo") (define/augment (decode stream parent) "foo")
(define/augment (encode stream val parent) "bar") (define/augment (encode stream val parent) "bar")
(define/override (size) 42)) (define/override (size) 42))
(define d (+Dummy)) (define d (+Dummy))
(check-true (Dummy? d)) (check-true (Dummy? d))
(check-exn exn:fail:contract? (λ () (send d decode 42))) (check-exn exn:fail:contract? (λ () (decode d 42)))
(check-not-exn (λ () (send d decode #"foo"))) (check-not-exn (λ () (decode d #"foo")))
(check-exn exn:fail:contract? (λ () (send d encode 42 21))) (check-exn exn:fail:contract? (λ () (encode d 42 21)))
(check-not-exn (λ () (send d encode (open-output-bytes) 42)))) (check-not-exn (λ () (encode d (open-output-bytes) 42))))

4
pitfall/restructure/private/utils.rkt
Unescape Escape View File

@ -1,8 +1,8 @@
#lang reader (submod "racket.rkt" reader) #lang reader (submod "racket.rkt" reader)
(provide (all-defined-out) (rename-out [resolveLength resolve-length])) (provide (all-defined-out))
(require "number.rkt") (require "number.rkt")
(define (resolveLength len-arg [stream #f] [parent #f]) (define (resolve-length len-arg [stream #f] [parent #f])
(cond (cond
[(not len-arg) #f] [(not len-arg) #f]
[(number? len-arg) len-arg] [(number? len-arg) len-arg]

37
pitfall/restructure/test/array-test.rkt
Unescape Escape View File

@ -15,7 +15,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
[array (+ArrayT uint8 4)]) [array (+ArrayT uint8 4)])
(check-equal? (send array decode stream) '(1 2 3 4))) (check-equal? (decode array stream) '(1 2 3 4)))
; it 'should decode fixed amount of bytes', -> ; it 'should decode fixed amount of bytes', ->
@ -24,7 +24,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.decode(stream).should.deep.equal [258, 772] ; array.decode(stream).should.deep.equal [258, 772]
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
[array (+ArrayT uint16be 4 'bytes)]) [array (+ArrayT uint16be 4 'bytes)])
(check-equal? (send array decode stream) '(258 772))) (check-equal? (decode array stream) '(258 772)))
; it 'should decode length from parent key', -> ; it 'should decode length from parent key', ->
@ -34,7 +34,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; ;
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
[array (+ArrayT uint8 4 'len)]) [array (+ArrayT uint8 4 'len)])
(check-equal? (send array decode stream (mhash 'len 4)) '(1 2 3 4))) (check-equal? (decode array stream (mhash 'len 4)) '(1 2 3 4)))
; it 'should decode amount of bytes from parent key', -> ; it 'should decode amount of bytes from parent key', ->
@ -43,7 +43,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.decode(stream, len: 4).should.deep.equal [258, 772] ; array.decode(stream, len: 4).should.deep.equal [258, 772]
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
[array (+ArrayT uint16be 'len 'bytes)]) [array (+ArrayT uint16be 'len 'bytes)])
(check-equal? (send array decode stream (mhash 'len 4)) '(258 772))) (check-equal? (decode array stream (mhash 'len 4)) '(258 772)))
; it 'should decode length as number before array', -> ; it 'should decode length as number before array', ->
@ -52,7 +52,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.decode(stream).should.deep.equal [1, 2, 3, 4] ; array.decode(stream).should.deep.equal [1, 2, 3, 4]
(let ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))]
[array (+ArrayT uint8 uint8)]) [array (+ArrayT uint8 uint8)])
(check-equal? (send array decode stream) '(1 2 3 4))) (check-equal? (decode array stream) '(1 2 3 4)))
; it 'should decode amount of bytes as number before array', -> ; it 'should decode amount of bytes as number before array', ->
@ -61,7 +61,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.decode(stream).should.deep.equal [258, 772] ; array.decode(stream).should.deep.equal [258, 772]
(let ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))]
[array (+ArrayT uint16be uint8 'bytes)]) [array (+ArrayT uint16be uint8 'bytes)])
(check-equal? (send array decode stream) '(258 772))) (check-equal? (decode array stream) '(258 772)))
; it 'should decode length from function', -> ; it 'should decode length from function', ->
; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] ; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5]
@ -69,7 +69,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.decode(stream).should.deep.equal [1, 2, 3, 4] ; array.decode(stream).should.deep.equal [1, 2, 3, 4]
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
[array (+ArrayT uint8 (λ _ 4))]) [array (+ArrayT uint8 (λ _ 4))])
(check-equal? (send array decode stream) '(1 2 3 4))) (check-equal? (decode array stream) '(1 2 3 4)))
; it 'should decode amount of bytes from function', -> ; it 'should decode amount of bytes from function', ->
@ -78,7 +78,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.decode(stream).should.deep.equal [258, 772] ; array.decode(stream).should.deep.equal [258, 772]
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
[array (+ArrayT uint16be (λ _ 4) 'bytes)]) [array (+ArrayT uint16be (λ _ 4) 'bytes)])
(check-equal? (send array decode stream) '(258 772))) (check-equal? (decode array stream) '(258 772)))
; it 'should decode to the end of the parent if no length is given', -> ; it 'should decode to the end of the parent if no length is given', ->
@ -87,13 +87,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.decode(stream, _length: 4, _startOffset: 0).should.deep.equal [1, 2, 3, 4] ; array.decode(stream, _length: 4, _startOffset: 0).should.deep.equal [1, 2, 3, 4]
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
[array (+ArrayT uint8)]) [array (+ArrayT uint8)])
(check-equal? (send array decode stream (mhash '_length 4 '_startOffset 0)) '(1 2 3 4))) (check-equal? (decode array stream (mhash '_length 4 '_startOffset 0)) '(1 2 3 4)))
; decode to the end of the stream if parent exists, but its length is 0 ; decode to the end of the stream if parent exists, but its length is 0
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
[array (+ArrayT uint8)]) [array (+ArrayT uint8)])
(check-equal? (send array decode stream (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5))) (check-equal? (decode array stream (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5)))
; it 'should decode to the end of the stream if no parent and length is given', -> ; it 'should decode to the end of the stream if no parent and length is given', ->
@ -102,7 +102,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.decode(stream).should.deep.equal [1, 2, 3, 4] ; array.decode(stream).should.deep.equal [1, 2, 3, 4]
(let ([stream (+DecodeStream (+Buffer '(1 2 3 4)))] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4)))]
[array (+ArrayT uint8)]) [array (+ArrayT uint8)])
(check-equal? (send array decode stream) '(1 2 3 4))) (check-equal? (decode array stream) '(1 2 3 4)))
; describe 'size', -> ; describe 'size', ->
@ -110,7 +110,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array = new ArrayT uint8, 10 ; array = new ArrayT uint8, 10
; array.size([1, 2, 3, 4]).should.equal 4 ; array.size([1, 2, 3, 4]).should.equal 4
(let ([array (+ArrayT uint8 10)]) (let ([array (+ArrayT uint8 10)])
(check-equal? (send array size '(1 2 3 4)) 4)) (check-equal? (size array '(1 2 3 4)) 4))
; it 'should add size of length field before string', -> ; it 'should add size of length field before string', ->
@ -118,14 +118,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
; array.size([1, 2, 3, 4]).should.equal 5 ; array.size([1, 2, 3, 4]).should.equal 5
; ;
(let ([array (+ArrayT uint8 uint8)]) (let ([array (+ArrayT uint8 uint8)])
(check-equal? (send array size '(1 2 3 4)) 5)) (check-equal? (size array '(1 2 3 4)) 5))
; it 'should use defined length if no value given', -> ; it 'should use defined length if no value given', ->
; array = new ArrayT uint8, 10 ; array = new ArrayT uint8, 10
; array.size().should.equal 10 ; array.size().should.equal 10
(let ([array (+ArrayT uint8 10)]) (let ([array (+ArrayT uint8 10)])
(check-equal? (send array size) 10)) (check-equal? (size array) 10))
; describe 'encode', -> ; describe 'encode', ->
@ -141,8 +141,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(let ([stream (+EncodeStream)] (let ([stream (+EncodeStream)]
[array (+ArrayT uint8 10)]) [array (+ArrayT uint8 10)])
(send array encode stream '(1 2 3 4)) (check-equal? (encode array #f '(1 2 3 4)) (+Buffer '(1 2 3 4))))
(check-equal? (send stream dump) (+Buffer '(1 2 3 4))))
; ;
@ -158,8 +157,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(let ([stream (+EncodeStream)] (let ([stream (+EncodeStream)]
[array (+ArrayT uint8 uint8)]) [array (+ArrayT uint8 uint8)])
(send array encode stream '(1 2 3 4)) (check-equal? (encode array #f '(1 2 3 4)) (+Buffer '(4 1 2 3 4))))
(check-equal? (send stream dump) (+Buffer '(4 1 2 3 4))))
; it 'should add pointers after array if length is encoded at start', (done) -> ; it 'should add pointers after array if length is encoded at start', (done) ->
@ -174,5 +172,4 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(let ([stream (+EncodeStream)] (let ([stream (+EncodeStream)]
[array (+ArrayT (+Pointer uint8 uint8) uint8)]) [array (+ArrayT (+Pointer uint8 uint8) uint8)])
(send array encode stream '(1 2 3 4)) (check-equal? (encode array #f '(1 2 3 4)) (+Buffer '(4 5 6 7 8 1 2 3 4))))
(check-equal? (send stream dump) (+Buffer '(4 5 6 7 8 1 2 3 4))))

20
pitfall/restructure/test/bitfield-test.rkt
Unescape Escape View File

@ -34,8 +34,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
; Jack: yes, Kack: no, Lack: no, Mack: yes, Nack: yes, Oack: no, Pack: yes, Quack: yes ; Jack: yes, Kack: no, Lack: no, Mack: yes, Nack: yes, Oack: no, Pack: yes, Quack: yes
(let ([stream (+DecodeStream (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK))))]) (let ([stream (+DecodeStream (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK))))])
(for/and ([(k v) (in-hash (send bitfield decode stream))]) (check-equal? (decode bitfield stream) (mhasheq 'Quack #t
(check-equal? v (hash-ref #hasheq((Quack . #t) (Nack . #t) (Lack . #f) (Oack . #f) (Pack . #t) (Mack . #t) (Jack . #t) (Kack . #f)) k)))) 'Nack #t
'Lack #f
'Oack #f
'Pack #t
'Mack #t
'Jack #t
'Kack #f)))
; ;
@ -48,6 +54,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
; bitfield.encode stream, Jack: yes, Kack: no, Lack: no, Mack: yes, Nack: yes, Oack: no, Pack: yes, Quack: yes ; bitfield.encode stream, Jack: yes, Kack: no, Lack: no, Mack: yes, Nack: yes, Oack: no, Pack: yes, Quack: yes
(let ([stream (+EncodeStream)]) (let ([stream (+EncodeStream)])
(define h #hasheq((Quack . #t) (Nack . #t) (Lack . #f) (Oack . #f) (Pack . #t) (Mack . #t) (Jack . #t) (Kack . #f))) (send bitfield encode stream (mhasheq 'Quack #t
(send bitfield encode stream h) 'Nack #t
'Lack #f
'Oack #f
'Pack #t
'Mack #t
'Jack #t
'Kack #f))
(check-equal? (send stream dump) (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK))))) (check-equal? (send stream dump) (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK)))))

31
pitfall/sugar/class.rkt
Unescape Escape View File

@ -19,9 +19,9 @@
(define-macro (as-method ID) (define-macro (as-method ID)
(with-pattern ([PRIVATE-ID (generate-temporary #'ID)]) (with-pattern ([PRIVATE-ID (generate-temporary #'ID)])
#'(begin #'(begin
(public [PRIVATE-ID ID]) (public [PRIVATE-ID ID])
(define (PRIVATE-ID . args) (apply ID this args))))) (define (PRIVATE-ID . args) (apply ID this args)))))
(define-macro (as-methods ID ...) (define-macro (as-methods ID ...)
@ -30,20 +30,23 @@
(define-macro (define-instance ID (MAKER BASE-CLASS . ARGS)) (define-macro (define-instance ID (MAKER BASE-CLASS . ARGS))
(with-pattern ([ID-CLASS (prefix-id #'BASE-CLASS ":" #'ID)]) (with-pattern ([ID-CLASS (prefix-id #'BASE-CLASS ":" #'ID)])
#'(define ID (let ([ID-CLASS (class BASE-CLASS (super-new))]) #'(define ID (let ([ID-CLASS (class BASE-CLASS (super-new))])
(MAKER ID-CLASS . ARGS))))) (MAKER ID-CLASS . ARGS)))))
(define-macro (define-subclass SUPERCLASS (ID . INIT-ARGS) . BODY) (define-macro (define-subclass SUPERCLASS (ID . INIT-ARGS) . BODY)
#'(define-subclass* SUPERCLASS (ID . INIT-ARGS) (super-new) . BODY)) #'(define-subclass* SUPERCLASS (ID . INIT-ARGS) (super-new) . BODY))
(define-macro (define-subclass* SUPERCLASS (ID . INIT-ARGS) . BODY) (define-macro (define-class-predicates ID)
(with-pattern ([+ID (prefix-id "+" #'ID)] (with-pattern ([+ID (prefix-id "+" #'ID)]
[ID? (suffix-id #'ID "?")]) [ID? (suffix-id #'ID "?")])
#'(begin #'(begin (define (ID? x) (is-a? x ID))
(define ID (class SUPERCLASS (init-field . INIT-ARGS) . BODY)) (define (+ID . args) (apply make-object ID args)))))
(define (ID? x) (is-a? x ID))
(define (+ID . args) (apply make-object ID args))))) (define-macro (define-subclass* SUPERCLASS (ID . INIT-ARGS) . BODY)
#'(begin
(define ID (class SUPERCLASS (init-field . INIT-ARGS) . BODY))
(define-class-predicates ID)))
(define-macro (push-field! FIELD O EXPR) (define-macro (push-field! FIELD O EXPR)
@ -70,7 +73,7 @@
(define-macro (getter-field [ID . EXPRS]) (define-macro (getter-field [ID . EXPRS])
(with-pattern ([_ID (prefix-id "_" #'ID)]) (with-pattern ([_ID (prefix-id "_" #'ID)])
#`(begin #`(begin
(field [(ID _ID) . EXPRS]) (field [(ID _ID) . EXPRS])
(public (_ID ID)) (public (_ID ID))
(#,(if (syntax-property caller-stx 'override) #'define/override #'define) (_ID) ID)))) (#,(if (syntax-property caller-stx 'override) #'define/override #'define) (_ID) ID))))
Write Preview
Loading…
Cancel
Save