Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Automated Resyntax fixes #586

Closed
wants to merge 1 commit into from
Closed

Automated Resyntax fixes #586

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions collection/association-list.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
(provide
(contract-out
[association-list (->* () #:rest key-value-list/c association-list?)]
[association-list? predicate/c]
[association-list? (-> any/c boolean?)]
[association-list-ref (-> association-list? any/c immutable-vector?)]
[association-list-size (-> association-list? natural?)]
[association-list-keys (-> association-list? multiset?)]
Expand All @@ -22,8 +22,8 @@
[association-list-contains-value? (-> association-list? any/c boolean?)]
[association-list-contains-entry? (-> association-list? entry? boolean?)]
[empty-association-list association-list?]
[empty-association-list? predicate/c]
[nonempty-association-list? predicate/c]))
[empty-association-list? (-> any/c boolean?)]
[nonempty-association-list? (-> any/c boolean?)]))

(require racket/list
racket/math
Expand Down
12 changes: 8 additions & 4 deletions collection/entry.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,8 @@
[mapping-keys (-> (-> any/c any/c) (transducer/c entry? entry?))]
[mapping-values (-> (-> any/c any/c) (transducer/c entry? entry?))]
[indexing (-> (-> any/c any/c) (transducer/c any/c entry?))]
[filtering-keys (-> predicate/c (transducer/c entry? entry?))]
[filtering-values (-> predicate/c (transducer/c entry? entry?))]
[filtering-keys (-> (-> any/c boolean?) (transducer/c entry? entry?))]
[filtering-values (-> (-> any/c boolean?) (transducer/c entry? entry?))]
[append-mapping-keys
(-> (-> any/c (sequence/c any/c)) (transducer/c entry? entry?))]
[append-mapping-values
Expand Down Expand Up @@ -87,11 +87,15 @@


(define (mapping-keys key-function)
(mapping (λ (e) (match e [(entry k v) (entry (key-function k) v)]))))
(mapping (λ (e)
(match-define (entry k v) e)
(entry (key-function k) v))))


(define (mapping-values value-function)
(mapping (λ (e) (match e [(entry k v) (entry k (value-function v))]))))
(mapping (λ (e)
(match-define (entry k v) e)
(entry k (value-function v)))))


(define (indexing key-function) (bisecting key-function values))
Expand Down
4 changes: 2 additions & 2 deletions collection/multiset.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,14 +32,14 @@


(require (for-syntax racket/base)
guard
racket/hash
racket/math
racket/set
racket/sequence
racket/set
racket/stream
racket/struct
rebellion/collection/entry
guard
rebellion/private/static-name
rebellion/streaming/reducer
rebellion/type/record)
Expand Down
4 changes: 2 additions & 2 deletions collection/range-set.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,8 +46,8 @@
(rename-out [range-set-overlaps? range-set-intersects?])

(contract-out
[empty-range-set? predicate/c]
[nonempty-range-set? predicate/c]))
[empty-range-set? (-> any/c boolean?)]
[nonempty-range-set? (-> any/c boolean?)]))


(module+ test
Expand Down
4 changes: 2 additions & 2 deletions collection/record.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
[build-record (-> (-> keyword? any/c) keyset? record?)]
[empty-record record?]
[record (unconstrained-domain-> record?)]
[record? predicate/c]
[record? (-> any/c boolean?)]
[record-contains-key? (-> record? keyword? boolean?)]
[record-map (-> record? (-> any/c any/c) record?)]
[record-merge2
Expand All @@ -18,7 +18,7 @@
[record-remove (-> record? keyword? record?)]
[record-size (-> record? natural?)]
[record-field (unconstrained-domain-> record-field?)]
[record-field? predicate/c]
[record-field? (-> any/c boolean?)]
[record-field-name (-> record-field? keyword?)]
[record-field-value (-> record-field? any/c)]))

Expand Down
6 changes: 3 additions & 3 deletions collection/set.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,9 @@
(provide
(contract-out
[empty-set empty-set?]
[empty-set? predicate/c]
[nonempty-set? predicate/c]
[mutable-set? predicate/c]
[empty-set? (-> any/c boolean?)]
[nonempty-set? (-> any/c boolean?)]
[mutable-set? (-> any/c boolean?)]
[into-set (reducer/c any/c set?)]
[into-mutable-set (reducer/c any/c mutable-set?)]))

Expand Down
42 changes: 17 additions & 25 deletions collection/table.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,13 +19,13 @@
[into-table (reducer/c record? table?)]))

(require (for-syntax racket/base)
guard
racket/math
racket/sequence
racket/stream
rebellion/collection/immutable-vector
rebellion/collection/keyset
rebellion/collection/record
guard
rebellion/private/printer-markup
rebellion/private/static-name
rebellion/streaming/reducer
Expand Down Expand Up @@ -88,34 +88,26 @@
(define msg "cannot be used outside a table expression")
(raise-syntax-error 'row msg stx))

(define-simple-macro
(table ((~literal columns) column:keyword ...)
(~and full-row ((~literal row) row-value:expr ...)) ...)
#:do [(define column-keywords
(sort (map syntax-e (syntax->list #'(column ...))) keyword<?))
(define-syntax-parse-rule (table ((~literal columns) column:keyword ...)
(~and full-row ((~literal row) row-value:expr ...)) ...)
#:do [(define column-keywords (sort (map syntax-e (syntax->list #'(column ...))) keyword<?))
(define num-columns (length column-keywords))
(define row-stxs (syntax->list #'(full-row ...)))
(define num-rows (length row-stxs))]
#:fail-when (findf (λ (row-stx)
(> (length (syntax->list row-stx))
(add1 num-columns)))
row-stxs)
(format "too many values in row, table has only ~v columns" num-columns)
#:fail-when (findf (λ (row-stx)
(< (length (syntax->list row-stx))
(add1 num-columns)))
row-stxs)
(format "not enough values in row, table expects ~v columns" num-columns)
#:fail-when (findf (λ (row-stx) (> (length (syntax->list row-stx)) (add1 num-columns)))
row-stxs) (format "too many values in row, table has only ~v columns"
num-columns)
#:fail-when (findf (λ (row-stx) (< (length (syntax->list row-stx)) (add1 num-columns)))
row-stxs) (format "not enough values in row, table expects ~v columns"
num-columns)
#:with size num-rows
#:with ((column-kw column-value ...) ...)
(apply map
list
(syntax->list #'(column ...))
(map syntax->list (syntax->list #'((row-value ...) ...))))
#:with ((column-kw-arg ...) ...)
#'((column-kw (immutable-vector column-value ...)) ...)
(constructor:table #:backing-column-vectors (record column-kw-arg ... ...)
#:size 'size))
#:with ((column-kw column-value ...) ...) (apply map
list
(syntax->list #'(column ...))
(map syntax->list
(syntax->list #'((row-value ...) ...))))
#:with ((column-kw-arg ...) ...) #'((column-kw (immutable-vector column-value ...)) ...)
(constructor:table #:backing-column-vectors (record column-kw-arg ... ...) #:size 'size))

(define (table-columns-ref tab column)
(record-ref (table-backing-column-vectors tab) column))
Expand Down
138 changes: 59 additions & 79 deletions type/record/private/definition-macro.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,87 +39,68 @@
#:with (position ...)
(for/list ([_ (in-syntax #'(id ...))] [n (in-naturals)]) #`'#,n))))

(define-simple-macro
(define-record-type id:id fields:record-fields
(~alt
(~optional (~and #:omit-root-binding omit-root-binding-kw))
(define-syntax-parse-rule (define-record-type
id:id
fields:record-fields
(~alt
(~optional (~and #:omit-root-binding omit-root-binding-kw))
(~optional (~seq #:descriptor-name descriptor:id)
#:defaults ([descriptor (default-descriptor-identifier #'id)])
#:name "#:descriptor-name option")
(~optional (~seq #:predicate-name predicate:id)
#:defaults ([predicate (default-predicate-identifier #'id)])
#:name "#:predicate-name option")
(~optional (~seq #:constructor-name constructor:id)
#:defaults ([constructor
(default-constructor-identifier #'id)])
#:name "#:constructor-name option")
(~optional (~seq #:accessor-name accessor:id)
#:defaults ([accessor (default-accessor-identifier #'id)])
#:name "#:accessor-name option")
(~optional (~seq #:pattern-name pattern:id)
#:defaults ((pattern (default-pattern-identifier #'id)))
#:name "#:pattern-name option")
(~optional (~seq #:inspector inspector:expr)
#:name "#:inspector option"
#:defaults ([inspector #'(current-inspector)]))
(~optional (~seq #:property-maker prop-maker:expr)
#:defaults ([prop-maker #'default-record-properties])
#:name "#:property-maker option")) ...)

(~optional
(~seq #:descriptor-name descriptor:id)
#:defaults ([descriptor (default-descriptor-identifier #'id)])
#:name "#:descriptor-name option")

(~optional
(~seq #:predicate-name predicate:id)
#:defaults ([predicate (default-predicate-identifier #'id)])
#:name "#:predicate-name option")

(~optional
(~seq #:constructor-name constructor:id)
#:defaults ([constructor (default-constructor-identifier #'id)])
#:name "#:constructor-name option")

(~optional
(~seq #:accessor-name accessor:id)
#:defaults ([accessor (default-accessor-identifier #'id)])
#:name "#:accessor-name option")

(~optional
(~seq #:pattern-name pattern:id)
#:defaults ([pattern (default-pattern-identifier #'id)])
#:name "#:pattern-name option")
#:with (field-accessor ...) (for/list ([field-id-stx (in-syntax #'(fields.id ...))])
(default-field-accessor-identifier #'id field-id-stx))

(~optional
(~seq #:inspector inspector:expr)
#:name "#:inspector option"
#:defaults ([inspector #'(current-inspector)]))

(~optional
(~seq #:property-maker prop-maker:expr)
#:defaults ([prop-maker #'default-record-properties])
#:name "#:property-maker option"))
...)

#:with (field-accessor ...)
(for/list ([field-id-stx (in-syntax #'(fields.id ...))])
(default-field-accessor-identifier #'id field-id-stx))
#:with root-binding (if (attribute omit-root-binding-kw)
#'(begin)
#'(define-syntax id
(record-binding #:type (record-type 'id
fields.keys
#:predicate-name 'predicate
#:constructor-name 'constructor
#:accessor-name 'accessor)
#:descriptor #'descriptor
#:predicate #'predicate
#:constructor #'constructor
#:accessor #'accessor
#:fields (list #'fields.id ...)
#:field-accessors (list #'field-accessor ...)
#:pattern #'pattern
#:macro
(make-variable-like-transformer #'constructor))))

#:with root-binding
(if (attribute omit-root-binding-kw)
#'(begin)
#'(define-syntax id
(record-binding
#:type
(record-type
'id fields.keys
#:predicate-name 'predicate
#:constructor-name 'constructor
#:accessor-name 'accessor)
#:descriptor #'descriptor
#:predicate #'predicate
#:constructor #'constructor
#:accessor #'accessor
#:fields (list #'fields.id ...)
#:field-accessors (list #'field-accessor ...)
#:pattern #'pattern
#:macro (make-variable-like-transformer #'constructor))))

(begin
(define descriptor
(make-record-implementation
(record-type
'id fields.keys
#:predicate-name 'predicate
#:constructor-name 'constructor
#:accessor-name 'accessor)
#:inspector inspector
#:property-maker prop-maker))
(make-record-implementation (record-type 'id
fields.keys
#:predicate-name 'predicate
#:constructor-name 'constructor
#:accessor-name 'accessor)
#:inspector inspector
#:property-maker prop-maker))
(define predicate (record-descriptor-predicate descriptor))
(define constructor (record-descriptor-constructor descriptor))
(define accessor (record-descriptor-accessor descriptor))
(define field-accessor
(make-record-field-accessor descriptor fields.position))
...
(define field-accessor (make-record-field-accessor descriptor fields.position)) ...
(define-match-expander pattern
(syntax-parser
#:track-literals
Expand Down Expand Up @@ -148,13 +129,12 @@
(~s ted) "#<person: #:age 42 #:favorite-color grey #:name \"Ted\">")))


(define-simple-macro
(define-record-setter record:record-id
(~optional
setter:id #:defaults ([setter (default-setter-identifier #'record)])))
(define-syntax-parse-rule (define-record-setter
record:record-id
(~optional setter:id
#:defaults ([setter (default-setter-identifier #'record)])))
(define (setter instance
(~@ record.field-keyword
[record.field (record.field-accessor instance)]) ...)
(~@ record.field-keyword [record.field (record.field-accessor instance)]) ...)
(record.constructor (~@ record.field-keyword record.field) ...)))

(module+ test
Expand Down
4 changes: 2 additions & 2 deletions type/record/private/provide-transformer.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@
#lang racket/base

(require (for-syntax racket/base
syntax/parse
racket/provide-transform
rebellion/type/record/binding))
rebellion/type/record/binding
syntax/parse))

(module+ test
(require rackunit
Expand Down