syndicate-lang
/
preserves
mirror of https://gitlab.com/preserves/preserves.git
1
0
Fork 1
Code Releases Activity

Avoid use of void so much

This commit is contained in:
Tony Garnock-Jones 2021-05-27 09:54:11 +02:00
parent ab12c6535f
commit d7bf235813
4 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
implementations/racket/preserves/preserves-schema/compiler.rkt
View File

@ -94,6 +94,8 @@
(cons (struct-stx (list name variant-name) '()) acc)] (cons (struct-stx (list name variant-name) '()) acc)]
[_ [_
(cons (struct-stx (list name variant-name) '(value)) acc)]))] (cons (struct-stx (list name variant-name) '(value)) acc)]))]
[(ty-unit)
(cons (struct-stx (list name) '()) acc)]
[(ty-record fields) [(ty-record fields)
(cons (struct-stx (list name) (map car fields)) acc)] (cons (struct-stx (list name) (map car fields)) acc)]
[_ [_

5
implementations/racket/preserves/preserves-schema/gen/schema.rkt
View File

@ -74,6 +74,7 @@
(SimplePattern-setof? p) (SimplePattern-setof? p)
(SimplePattern-dictof? p) (SimplePattern-dictof? p)
(SimplePattern-Ref? p))) (SimplePattern-Ref? p)))
(struct Version () #:prefab)
(begin (begin
(define (parse-AtomKind input) (define (parse-AtomKind input)
(match (match
@ -362,7 +363,7 @@
(parse-success-or-error 'parse-SimplePattern parse-SimplePattern))) (parse-success-or-error 'parse-SimplePattern parse-SimplePattern)))
(begin (begin
(define (parse-Version input) (define (parse-Version input)
(match input ((and dest (== '1)) (void)) (_ eof))) (match input ((and dest (== '1)) (Version)) (_ eof)))
(define parse-Version! (define parse-Version!
(parse-success-or-error 'parse-Version parse-Version))) (parse-success-or-error 'parse-Version parse-Version)))
(define (AtomKind->preserves input) (define (AtomKind->preserves input)
@ -519,4 +520,4 @@
(SimplePattern->preserves $key) (SimplePattern->preserves $key)
(SimplePattern->preserves $value)))) (SimplePattern->preserves $value))))
((SimplePattern-Ref src) (Ref->preserves src)))) ((SimplePattern-Ref src) (Ref->preserves src))))
(define (Version->preserves input) (match input ((? void?) '1)))) (define (Version->preserves input) (match input ((Version) '1))))

2
implementations/racket/preserves/preserves-schema/parser.rkt
View File

@ -41,7 +41,7 @@
(define (construct name wrap? ty) (define (construct name wrap? ty)
(match ty (match ty
[(ty-record fields) `(,name ,@(map escape (map car fields)))] [(ty-record fields) `(,name ,@(map escape (map car fields)))]
[(ty-unit) (if wrap? `(,name) `(void))] [(ty-unit) `(,name)]
[_ (if wrap? `(,name dest) 'dest)])) [_ (if wrap? `(,name dest) 'dest)]))
(define (maybe-dest dest-pat-stx pat) (define (maybe-dest dest-pat-stx pat)

2
implementations/racket/preserves/preserves-schema/unparser.rkt
View File

@ -40,7 +40,7 @@
(define (deconstruct name wrap? ty) (define (deconstruct name wrap? ty)
(match ty (match ty
[(ty-record fields) `(,name ,@(map escape (map car fields)))] [(ty-record fields) `(,name ,@(map escape (map car fields)))]
[(ty-unit) (if wrap? `(,name) '(? void?))] [(ty-unit) `(,name)]
[_ (if wrap? `(,name src) 'src)])) [_ (if wrap? `(,name src) 'src)]))
(define (pattern->unparser pattern src-stx) (define (pattern->unparser pattern src-stx)