diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..f114789 --- /dev/null +++ b/Makefile @@ -0,0 +1,10 @@ +.PHONY: all clean + +all: + raco setup ./crossfire/ + +check: + raco check-requires -- crossfire/*.rkt + +clean: + $(RM) -r crossfire/doc crossfire/compiled crossfire/scribblings/compiled diff --git a/crossfire/codegen.rkt b/crossfire/codegen.rkt new file mode 100644 index 0000000..fd9fe8b --- /dev/null +++ b/crossfire/codegen.rkt @@ -0,0 +1,31 @@ +#lang racket/base + +(require racket/runtime-path + scribble/text (rename-in scribble/text/output [output scribble-output])) + +(provide pattern-codegen) + +;; templating infrastructure + +(define (eval-template file vars [port (current-output-port)]) + (define cs (current-namespace)) + (define output-exp + (parameterize ([current-namespace (make-base-namespace)]) + (namespace-attach-module cs 'scribble/text) + (namespace-require 'scribble/text) + (hash-for-each vars namespace-set-variable-value!) + (eval `(include/text ,file)))) + (scribble-output output-exp port)) + +;; there used to be a racket implementation of the input generator but it majorly violated the +;; design recipe and got obsoleted by the template C version (which is intended to be more portable +;; and faster) + +;; ok gamer move time +(define-runtime-path codegen-template "codegen.template") +(define (pattern-codegen pattern pp-start pp-end) + (eval-template + `(file ,(path->string codegen-template)) + (hash 'pattern pattern + 'pp-start pp-start + 'pp-end pp-end))) diff --git a/crossfire/main.rkt b/crossfire/main.rkt index 2232d79..73dddd3 100644 --- a/crossfire/main.rkt +++ b/crossfire/main.rkt @@ -1,9 +1,8 @@ #lang racket/base -(require racket/bool racket/function racket/match racket/runtime-path racket/set racket/vector - (rename-in scribble/text/output [output scribble-output]) - scribble/text - (for-syntax racket/base racket/syntax)) +(require racket/bool racket/function racket/match + (for-syntax racket/base racket/syntax) + "pattern.rkt" "codegen.rkt") (module+ test (require rackunit)) @@ -22,103 +21,8 @@ (void))) -;; templating infrastructure - -(define (eval-template file vars [port (current-output-port)]) - (define cs (current-namespace)) - (define output-exp - (parameterize ([current-namespace (make-base-namespace)]) - (namespace-attach-module cs 'scribble/text) - (namespace-require 'scribble/text) - (hash-for-each vars namespace-set-variable-value!) - (eval `(include/text ,file)))) - (scribble-output output-exp port)) - - ;; manifest.rkt processing -;; Iset is a listof Interval -;; Interval is a (cons start end) and represents [start, end) - -(define (make-iset) '()) - -(define (iset-add iset start end) - (when (> start end) - (error "invalid interval" start end)) - - (define (iset-merge iset) - (define (iset-merge-helper iset acc) - (match iset - ['() (reverse acc)] - [(cons (cons fs fe) r) - (match-define (cons (cons afs afe) ar) acc) - (if (<= fs afe) - (iset-merge-helper r (cons (cons afs (max fe afe)) ar)) - (iset-merge-helper r (cons (cons fs fe) acc)))])) - - (if (empty? iset) - iset - (iset-merge-helper (rest iset) (list (first iset))))) - - (define (iset-insert iset start end) - (match iset - ['() (list (cons start end))] - [(cons (cons fs fe) r) - (if (>= fs start) - (cons (cons start end) iset) - (cons (cons fs fe) (iset-insert r start end)))])) - - (iset-merge (iset-insert iset start end))) - -(define (iset-count iset) - (for/sum ([ival (in-list iset)]) - (- (cdr ival) (car ival)))) - -;; IsetPos is a (cons inum ival) -;; inum - the interval number within the iset -;; ival - the actual input value - -;; converts a position of [0, iset-count) to 2 values -;; - iset interval number -;; - actual value within the interval -;; allows going up to iset-count to support upper exclusive bounds of intervals -(define (pos->iset-pos iset pos) - (define (helper iset pos) - (match-define (cons (cons fs fe) r) iset) - (define delta (- fe fs)) - (if (< pos delta) - (cons 0 (+ fs pos)) - (match-let ([(cons inum val) (helper r (- pos delta))]) - (cons (add1 inum) val)))) - (define cnt (iset-count iset)) - (cond - [(> pos cnt) (error "iset-pos out of range" iset pos)] - [(= pos cnt) - ;; support interval exclusive upper bound - (match-define (cons inum ival) (helper iset (sub1 pos))) - (cons inum (add1 ival))] - [else (helper iset pos)])) - -(define (char->iset ch) - (define cp (char->integer ch)) - (iset-add (make-iset) cp (add1 cp))) - -(define (string->iset str) - (for/fold ([iset (make-iset)]) ([ch (in-string str)]) - (define cp (char->integer ch)) - (iset-add iset cp (add1 cp)))) - -(define (range->iset a b) - (iset-add (make-iset) a b)) - -(define builtin-isets - (hash "?l" (string->iset "abcdefghijklmnopqrstuvwxyz") - "?u" (string->iset "ABCDEFGHIJKLMNOPQRSTUVWXYZ") - "?d" (string->iset "0123456789") - "?s" (string->iset " !\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~") - "?a" (range->iset 32 127) - "?b" (range->iset 0 256))) - (define (parse-manifest manifest-def) (struct manifest [name mode command isets pattern] #:transparent) @@ -158,34 +62,7 @@ (values (manifest-name mf) (manifest-mode mf) (manifest-command mf) pattern)) -;; pattern processing - -;; a PatternPos is a vector of IsetPos - -(define (pattern-count pattern) - (for/fold ([sum 1]) ([p (in-vector pattern)]) - (* sum (iset-count p)))) - -(define (pattern-start pattern) - (for/vector ([iset (in-vector pattern)]) - (pos->iset-pos iset 0))) - -(define (pattern-end pattern) - (for/vector ([iset (in-vector pattern)]) - (pos->iset-pos iset (iset-count iset)))) - -;; there used to be a racket implementation of the input generator but it majorly violated the -;; design recipe and got obsoleted by the template C version (which is intended to be more portable -;; and faster) - -;; ok gamer move time -(define-runtime-path codegen-template "codegen.template") -(define (pattern-codegen pattern pp-start pp-end) - (eval-template - `(file ,(path->string codegen-template)) - (hash 'pattern pattern - 'pp-start pp-start - 'pp-end pp-end))) +;; test code (define-values [name mode command pattern] (parse-manifest diff --git a/crossfire/pattern.rkt b/crossfire/pattern.rkt new file mode 100644 index 0000000..324ff03 --- /dev/null +++ b/crossfire/pattern.rkt @@ -0,0 +1,106 @@ +#lang racket/base + +(require racket/list racket/match) + +(provide make-iset iset-add iset-count pos->iset-pos + char->iset string->iset range->iset + builtin-isets + pattern-count pattern-start pattern-end) + +;; pattern processing + +;; Iset is a listof Interval +;; Interval is a (cons start end) and represents [start, end) + +(define (make-iset) '()) + +(define (iset-add iset start end) + (when (> start end) + (error "invalid interval" start end)) + + (define (iset-merge iset) + (define (iset-merge-helper iset acc) + (match iset + ['() (reverse acc)] + [(cons (cons fs fe) r) + (match-define (cons (cons afs afe) ar) acc) + (if (<= fs afe) + (iset-merge-helper r (cons (cons afs (max fe afe)) ar)) + (iset-merge-helper r (cons (cons fs fe) acc)))])) + + (if (empty? iset) + iset + (iset-merge-helper (rest iset) (list (first iset))))) + + (define (iset-insert iset start end) + (match iset + ['() (list (cons start end))] + [(cons (cons fs fe) r) + (if (>= fs start) + (cons (cons start end) iset) + (cons (cons fs fe) (iset-insert r start end)))])) + + (iset-merge (iset-insert iset start end))) + +(define (iset-count iset) + (for/sum ([ival (in-list iset)]) + (- (cdr ival) (car ival)))) + +;; IsetPos is a (cons inum ival) +;; inum - the interval number within the iset +;; ival - the actual input value + +;; converts a position of [0, iset-count) to 2 values +;; - iset interval number +;; - actual value within the interval +;; allows going up to iset-count to support upper exclusive bounds of intervals +(define (pos->iset-pos iset pos) + (define (helper iset pos) + (match-define (cons (cons fs fe) r) iset) + (define delta (- fe fs)) + (if (< pos delta) + (cons 0 (+ fs pos)) + (match-let ([(cons inum val) (helper r (- pos delta))]) + (cons (add1 inum) val)))) + (define cnt (iset-count iset)) + (cond + [(> pos cnt) (error "iset-pos out of range" iset pos)] + [(= pos cnt) + ;; support interval exclusive upper bound + (match-define (cons inum ival) (helper iset (sub1 pos))) + (cons inum (add1 ival))] + [else (helper iset pos)])) + +(define (char->iset ch) + (define cp (char->integer ch)) + (iset-add (make-iset) cp (add1 cp))) + +(define (string->iset str) + (for/fold ([iset (make-iset)]) ([ch (in-string str)]) + (define cp (char->integer ch)) + (iset-add iset cp (add1 cp)))) + +(define (range->iset a b) + (iset-add (make-iset) a b)) + +(define builtin-isets + (hash "?l" (string->iset "abcdefghijklmnopqrstuvwxyz") + "?u" (string->iset "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + "?d" (string->iset "0123456789") + "?s" (string->iset " !\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~") + "?a" (range->iset 32 127) + "?b" (range->iset 0 256))) + +;; a PatternPos is a vector of IsetPos + +(define (pattern-count pattern) + (for/fold ([sum 1]) ([p (in-vector pattern)]) + (* sum (iset-count p)))) + +(define (pattern-start pattern) + (for/vector ([iset (in-vector pattern)]) + (pos->iset-pos iset 0))) + +(define (pattern-end pattern) + (for/vector ([iset (in-vector pattern)]) + (pos->iset-pos iset (iset-count iset))))