98 lines
2.7 KiB
Racket
98 lines
2.7 KiB
Racket
#lang racket/base
|
|
(require
|
|
racket/port
|
|
racket/path
|
|
racket/match
|
|
racket/stream)
|
|
|
|
;; -----
|
|
|
|
(struct desc [name vals-alist]
|
|
#:transparent)
|
|
|
|
(define (make-desc name syms strs)
|
|
(desc name
|
|
(sort (map cons syms strs)
|
|
string<?
|
|
#:key cdr)))
|
|
|
|
(define (read-desc port)
|
|
(match (read port)
|
|
[(? eof-object?) eof]
|
|
[`[,(? symbol? name)
|
|
(,(? symbol? syms)
|
|
,(? string? strs))
|
|
...]
|
|
(make-desc name syms strs)]
|
|
[s
|
|
(error (format "invalid enum description: ~s" s))]))
|
|
|
|
(define (parser-file-name dsc)
|
|
(format "~a.parser.inc" (desc-name dsc)))
|
|
|
|
(define (printer-file-name dsc)
|
|
(format "~a.printer.inc" (desc-name dsc)))
|
|
|
|
(define (write-parser dsc [port (current-output-port)])
|
|
(match-define (desc name vals) dsc)
|
|
(for ([v+s (in-list vals)]
|
|
[i (in-naturals)])
|
|
(match-define (cons val str) v+s)
|
|
(when (> i 0)
|
|
(fprintf port "} else "))
|
|
(fprintf port "if (strcmp(str, ~s) == 0) {\n val = ~a;\n"
|
|
str val))
|
|
(unless (null? vals)
|
|
(fprintf port "} else "))
|
|
(fprintf port "{\n return 1;\n}\n"))
|
|
|
|
(define (write-printer dsc [port (current-output-port)])
|
|
(match-define (desc name vals) dsc)
|
|
(fprintf port "switch (val) {\n")
|
|
(for ([v+s (in-list vals)])
|
|
(match-define (cons val str) v+s)
|
|
(fprintf port "case ~a:\n str = ~s;\n break;\n" val str))
|
|
(fprintf port "default:\n IMPOSSIBLE(\"invalid enum value for `~a' printer\");\n}\n"
|
|
name))
|
|
|
|
;; -----
|
|
|
|
(define (in-scan dir-path)
|
|
(for*/stream ([file-path (in-directory dir-path)]
|
|
#:when (equal? (path-get-extension file-path)
|
|
#".enums")
|
|
[desc (in-port read-desc (open-input-file file-path))])
|
|
desc))
|
|
|
|
(define (scan+gen scan-dir
|
|
build-dir)
|
|
(for ([dsc (in-scan scan-dir)])
|
|
(write-parser dsc
|
|
(open-output-file (build-path build-dir (parser-file-name dsc))
|
|
#:exists 'replace))
|
|
(write-printer dsc
|
|
(open-output-file (build-path build-dir (printer-file-name dsc))
|
|
#:exists 'replace))))
|
|
|
|
;; -----
|
|
|
|
(module+ test
|
|
(define (display-parser dsc)
|
|
(for ([x (in-lines (open-input-string
|
|
(with-output-to-string
|
|
(λ () (write-parser dsc)))))])
|
|
(printf "; ~a\n" x)))
|
|
|
|
(display-parser (make-desc 'foobar
|
|
'(BAR FOO FAR BOO)
|
|
'("bar" "foo" "far" "boo")))
|
|
|
|
(displayln (make-string 80 #\-))
|
|
|
|
(display-parser (make-desc 'empty '() '())))
|
|
|
|
(module+ main
|
|
(match (current-command-line-arguments)
|
|
[(vector src build)
|
|
(scan+gen src build)]))
|