haskal
/
crossfire
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

make pattern definition flexible

This commit is contained in:
xenia 2020-11-16 01:01:28 -05:00
parent 64bbf52590
commit d294034a6e
1 changed files with 21 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
crossfire/main.rkt
View File

@ -16,7 +16,7 @@
;; You should have received a copy of the GNU Affero General Public License ;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(require racket/bool racket/function racket/match (require racket/bool racket/function racket/match racket/vector
(for-syntax racket/base racket/syntax) (for-syntax racket/base racket/syntax)
"pattern.rkt" "codegen.rkt") "pattern.rkt" "codegen.rkt")
@ -61,19 +61,32 @@
(struct-copy manifest mf (struct-copy manifest mf
[isets (hash-set (manifest-isets mf) [isets (hash-set (manifest-isets mf)
(symbol->string name) (string->integer-set val))])] (symbol->string name) (string->integer-set val))])]
[(list 'pattern pattern) (struct-copy manifest mf [pattern pattern])]))) [(list 'pattern pattern ...) (struct-copy manifest mf [pattern pattern])])))
(check-false name) (check-false name)
(check-false command) (check-false command)
(check-false pattern) (check-false pattern)
(define isets (manifest-isets mf)) (define isets (manifest-isets mf))
(define pattern (define (get-iset x)
(for/vector ([x (in-list (regexp-match* #rx"\\??." (manifest-pattern mf)))]) (hash-ref isets x (lambda () (error "no such iset defined" x))))
(define (parse-string-pattern ptn)
(for/vector ([x (in-list (regexp-match* #rx"\\??." ptn))])
(if (= 1 (string-length x)) (if (= 1 (string-length x))
(char->integer-set (string-ref x 0)) (char->integer-set (string-ref x 0))
(hash-ref isets x (lambda () (error "no such iset defined" x)))))) (get-iset x))))
(values (manifest-name mf) (manifest-mode mf) (manifest-command mf) pattern))
(define patterns
(for/list ([x (in-list (manifest-pattern mf))])
(match x
[(? string?) (parse-string-pattern x)]
[(? symbol?) (vector (get-iset (symbol->string x)))]
[(list start end) (vector (range->integer-set start end))]
[_ (error "unrecognized pattern element in manifest" x)])))
(values (manifest-name mf) (manifest-mode mf) (manifest-command mf)
(apply vector-append patterns)))
;; test code ;; test code
@ -83,7 +96,8 @@
'((name "test") '((name "test")
(mode stdio) (mode stdio)
(command ("meme")) (command ("meme"))
(pattern "?d_?d")))) (iset ?m "0123456789")
(pattern ?m "_?d"))))
(pattern-codegen pattern mode (pattern-start pattern) (pattern-end pattern)) (pattern-codegen pattern mode (pattern-start pattern) (pattern-end pattern))
(printf "// total: ~a\n" (pattern-count pattern)) (printf "// total: ~a\n" (pattern-count pattern))