76 lines
2.3 KiB
Racket
76 lines
2.3 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/bool racket/function racket/match
|
|
(for-syntax racket/base racket/syntax)
|
|
"pattern.rkt" "codegen.rkt")
|
|
|
|
(module+ test
|
|
(require rackunit))
|
|
|
|
(module+ test
|
|
(check-equal? (+ 2 2) 4))
|
|
|
|
(module+ main
|
|
(require racket/cmdline)
|
|
(define who (box "world"))
|
|
(command-line
|
|
#:program "my-program"
|
|
#:once-each
|
|
[("-n" "--name") name "Who to say hello to" (set-box! who name)]
|
|
#:args ()
|
|
(void)))
|
|
|
|
|
|
;; manifest.rkt processing
|
|
|
|
(define (parse-manifest manifest-def)
|
|
(struct manifest [name mode command isets pattern] #:transparent)
|
|
|
|
(define (eq/m x) (curry equal? x))
|
|
|
|
(define-syntax (check-false stx)
|
|
(syntax-case stx ()
|
|
[(_ what)
|
|
(with-syntax ([id (format-id stx "manifest-~a" #'what)]
|
|
[idsym #''what])
|
|
#'(when (false? (id mf))
|
|
(error "manifest attribute missing:" idsym)))]))
|
|
|
|
(define mf
|
|
(for/fold ([mf (manifest #f 'stdin #f builtin-isets #f)])
|
|
([line (in-list manifest-def)])
|
|
(match line
|
|
[(list (? (eq/m 'name)) name) (struct-copy manifest mf [name name])]
|
|
[(list (? (eq/m 'mode)) mode) (struct-copy manifest mf [mode mode])]
|
|
[(list (? (eq/m 'command)) command) (struct-copy manifest mf [command command])]
|
|
[(list (? (eq/m 'iset)) name val)
|
|
(struct-copy manifest mf
|
|
[isets (hash-set (manifest-isets mf)
|
|
(symbol->string name) (string->iset val))])]
|
|
[(list (? (eq/m 'pattern)) pattern) (struct-copy manifest mf [pattern pattern])])))
|
|
|
|
(check-false name)
|
|
(check-false command)
|
|
(check-false pattern)
|
|
|
|
(define isets (manifest-isets mf))
|
|
(define pattern
|
|
(for/vector ([x (in-list (regexp-match* #rx"\\??." (manifest-pattern mf)))])
|
|
(if (= 1 (string-length x))
|
|
(char->iset (string-ref x 0))
|
|
(hash-ref isets x (lambda () (error "no such iset defined" x))))))
|
|
(values (manifest-name mf) (manifest-mode mf) (manifest-command mf) pattern))
|
|
|
|
|
|
;; test code
|
|
|
|
(define-values [name mode command pattern]
|
|
(parse-manifest
|
|
'((name "test")
|
|
(mode callback)
|
|
(command ("meme"))
|
|
(pattern "test?d?a?a?s"))))
|
|
|
|
(pattern-codegen pattern mode (pattern-start pattern) (pattern-end pattern))
|
|
(printf "// total: ~a\n" (pattern-count pattern))
|