ref: 853cdcee8254f89ebba66b1241081c31e30fe557
parent: a395ad1f4340998f1e0aa06ecf4f1c3f91ffbe81
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu May 30 13:44:57 EDT 2024
change to syntax-parse
--- a/otf.rkt
+++ b/otf.rkt
@@ -1,7 +1,9 @@
#!/usr/bin/env racket
#lang racket
-(require racket/format)
+(require (for-syntax racket/format))
+(require (for-syntax syntax/parse))
+
(require racket/generic)
(define types '())
@@ -10,6 +12,14 @@
(define (indent lst)
(map (λ (str) (string-append "\t" str)) lst))
+(define (c-typedef? s)
+ (string-prefix? s "typedef"))
+
+(define (format f)
+ (define-values (a b) (partition c-typedef? (flatten (map f cmplxs))))
+ (define ps (list "/* this file is generated. do not modify. */\n" a b (map f types) ""))
+ (string-join (flatten ps) "\n"))
+
(define-generics code (gen-h code) (gen-c code) (c-type code))
(define-struct type (name bits c parse)
@@ -73,7 +83,7 @@
(define (c-type c)
(cmplx-name c))])
-(define (autoparse bits ctype)
+(define-for-syntax (autoparse bits ctype)
(λ (b [index 0])
(define cast (~a "(" ctype ")"))(define (f index bits)
@@ -82,43 +92,32 @@
(~a (if (> sh 24) cast "") b "[" index "]" tail))
(~a (if (<= bits 32) cast "") "(" (f index bits) ")")))-(define-syntax mktype
- (syntax-rules ()
- [(_ typ bits c)
- (begin
- (define typ (make-type `typ bits `c (autoparse bits `c)))
- (set! types (append types (list typ))))]
- [(_ typ bits c parse)
- (begin
- (define typ (make-type `typ bits `typ parse))
- (set! types (append types (list typ))))]))
+(define-syntax (mktype stx)
+ (syntax-parse stx
+ [(_ typ:id bits:nat c:id) #'(mktype typ bits c #'(autoparse bits c))]
+ [(_ typ:id bits:nat c:id parse:expr)
+ #'(begin
+ (define typ (make-type `typ bits `typ parse))
+ (set! types (append types (list typ))))]))
-(define-syntax mkcmplx
- (syntax-rules ()
- [(_ typ fields tag)
- (begin
- (define typ (make-cmplx `typ fields tag))
- (set! cmplxs (append cmplxs (list typ))))]
- [(_ typ fields)
- (begin
- (define typ (make-cmplx `typ fields ""))
- (set! cmplxs (append cmplxs (list typ))))]))
+(define-syntax (mkcmplx stx)
+ (syntax-parse stx
+ [(_ typ:id fields:expr tag:string)
+ #'(begin
+ (define typ (make-cmplx `typ fields tag))
+ (set! cmplxs (append cmplxs (list typ))))]
+ [(_ typ:id fields:expr) #'(mkcmplx typ fields "")]))
-(define-syntax mkfields
- (syntax-rules ()
- [(_ (type name [count])) (list (fieldarr type `name `count))]
- [(_ (type name))
- (list (field type
- `name))]
- [(_ x y ...) (append (mkfields x) (mkfields y ...))]))
+(define-syntax (mkfield stx)
+ (syntax-parse stx
+ [(_ type:id name:id [count:id]) #'(fieldarr type `name `count)]
+ [(_ type:id name:id)
+ #'(field type
+ `name)]))
-(define (c-typedef? s)
- (string-prefix? s "typedef"))
-
-(define (format f)
- (define-values (a b) (partition c-typedef? (flatten (map f cmplxs))))
- (define ps (list "/* this file is generated. do not modify. */\n" a b (map f types) ""))
- (string-join (flatten ps) "\n"))
+(define-syntax (mkfields stx)
+ (syntax-parse stx
+ [(_ x ...) #'(list (mkfield {~@ . x}) ...)]))(mktype uint8 8 u8int)
(mktype int8 8 s8int)