diff --git a/crossfire/codegen.rktc b/crossfire/codegen.rktc index 7d8fd7e..144de2a 100644 --- a/crossfire/codegen.rktc +++ b/crossfire/codegen.rktc @@ -54,11 +54,13 @@ typedef struct { int crossfire_main(callback cb) { char buf [ @(* 20 (vector-length pattern)) ]; + // @format["~s" pp-start] @(for/list ([num (in-naturals)] [iset-pos (in-vector pp-start)]) @list{size_t @(format "i~a" num) = @(car iset-pos) ; vartype @(format "v~a" num) = @(cdr iset-pos) ; }) + ssize_t res; goto l_inner; @@ -78,6 +80,7 @@ int crossfire_main(callback cb) { (string-join (for/list ([i (in-range (vector-length pattern))]) (format "vartype v~a" i)) ",")) @(define fmt (string-join (for/list ([i (in-range (vector-length pattern))]) c-type-fmt) " ")) + l_inner: @(define (end-conditionals) @@ -85,19 +88,22 @@ l_inner: (for/list ([num (in-naturals)] [iset-pos (in-vector pp-end)]) (define iter (format "i~a" num)) (define viter (format "v~a" num)) + @; ranges are inclusive, but since we exit _after_ printing/callbacking we use >= @list{ @iter >= @(car iset-pos) && @viter >= @(cdr iset-pos) }) " && ")) + @(match mode + ['stdio + @list{res = snprintf(buf, sizeof(buf), @(format "\"~a\\n\"" fmt), @vs ); + fwrite(buf, res, 1, stdout);}] + ['callback + @list{ if (cb( @vs )) { cf_report_success( @vs ); return 0; } }]) + + // @format["~s" pp-end] if ( @end-conditionals[] ) { goto l_end; } - @(match mode - ['stdio - @list{ssize_t res = snprintf(buf, sizeof(buf), @(format "\"~a\\n\"" fmt), @vs ); - fwrite(buf, res, 1, stdout);}] - ['callback - @list{ if (cb( @vs )) { cf_report_success( @vs ); return 0; } }]) @(for/list ([iset (in-vector pattern)]) "}}") l_end: diff --git a/crossfire/main.rkt b/crossfire/main.rkt index 6e34401..d2b8832 100644 --- a/crossfire/main.rkt +++ b/crossfire/main.rkt @@ -40,7 +40,7 @@ ;; manifest.rkt processing (define (parse-manifest manifest-def) - (struct manifest [name mode command isets pattern] #:transparent) + (struct manifest [name arch resources mode command isets pattern] #:transparent) (define-syntax (check-false stx) (syntax-case stx () @@ -51,10 +51,12 @@ (error "manifest attribute missing:" idsym)))])) (define mf - (for/fold ([mf (manifest #f 'stdin #f builtin-isets #f)]) + (for/fold ([mf (manifest #f #f #f 'stdio #f builtin-isets #f)]) ([line (in-list manifest-def)]) (match line [(list 'name name) (struct-copy manifest mf [name name])] + [(list 'arch arch ...) (struct-copy manifest mf [arch arch])] + [(list 'resources resources ...) (struct-copy manifest mf [resources resources])] [(list 'mode mode) (struct-copy manifest mf [mode mode])] [(list 'command command) (struct-copy manifest mf [command command])] [(list 'iset name val) @@ -85,19 +87,29 @@ [(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))) + (values (manifest-name mf) (manifest-arch mf) (manifest-resources mf) (manifest-mode mf) + (manifest-command mf) (apply vector-append patterns))) ;; test code -(define-values [name mode command pattern] +(define-values [name arch resources mode command pattern] (parse-manifest '((name "test") + ;; supported arch triples + (arch "aarch64-unknown-linux-gnu" "aarch64-linux-gnu") + ;; required resources + (resources "hifive-board" "cuda") + ;; stdio or callback (mode stdio) + ;; command to start the brute force process (command ("meme")) + ;; a helper integer set (iset ?m "0123456789") + ;; brute force pattern (pattern ?m "_?d")))) -(pattern-codegen pattern mode (pattern-start pattern) (pattern-end pattern)) +(pattern-codegen pattern mode (resolve-pattern-pos pattern (pos->pattern-pos pattern 10)) + (resolve-pattern-pos pattern + (pos->pattern-pos pattern 21))) (printf "// total: ~a\n" (pattern-count pattern)) diff --git a/crossfire/pattern.rkt b/crossfire/pattern.rkt index 9caf13a..256aa9f 100644 --- a/crossfire/pattern.rkt +++ b/crossfire/pattern.rkt @@ -16,22 +16,18 @@ ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see . -(require (only-in data/integer-set make-integer-set integer-set-contents [union integer-set-union]) - racket/list racket/match) +(require (only-in data/integer-set make-integer-set integer-set-contents [union integer-set-union] + [count integer-set-count]) + racket/list racket/match racket/vector) -(provide integer-set-count pos->integer-set-pos +(provide pos->integer-set-pos char->integer-set string->integer-set range->integer-set builtin-isets - pattern-count pattern-start pattern-end) + pattern-count pos->pattern-pos resolve-pattern-pos) ;; pattern processing ;; NOTE: data/integer-set WFS intervals are INCLUSIVE -;; counts the total number of integers in the set -(define (integer-set-count iset) - (for/sum ([ival (in-list (integer-set-contents iset))]) - (- (add1 (cdr ival)) (car ival)))) - ;; IsetPos is a (cons inum ival) ;; inum - the interval number within the iset ;; ival - the actual input value @@ -39,23 +35,20 @@ ;; converts a position of [0, integer-set-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 +;; this assists C code in determing where to start and end +;; (this could be moved to pure C i guess) (define (pos->integer-set-pos iset pos) (define (helper wfs pos) - (match-define (cons (cons fs fe) r) wfs) - (define delta (- (add1 fe) fs)) - (if (< pos delta) - (cons 0 (+ fs pos)) - (match-let ([(cons inum val) (helper r (- pos delta))]) - (cons (add1 inum) val)))) - (define cnt (integer-set-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 (integer-set-contents iset) (sub1 pos))) - (cons inum (add1 ival))] - [else (helper (integer-set-contents iset) pos)])) + (match wfs + [(cons (cons fs fe) r) + (define delta (- (add1 fe) fs)) + (if (< pos delta) + (cons 0 (+ fs pos)) + (match-let ([(cons inum val) (helper r (- pos delta))]) + (cons (add1 inum) val)))] + [_ (error "iset-pos out of range" iset pos)])) + + (helper (integer-set-contents iset) pos)) (define (char->integer-set ch) (define x (char->integer ch)) @@ -77,16 +70,34 @@ "?a" (range->integer-set 32 126) "?b" (range->integer-set 0 255))) -;; a PatternPos is a vector of IsetPos +;; resolved pattern pos: vector of IsetPos (obtained with pos->integer-set-pos) +;; unresolved pattern pos: vector of Nat [0, count of iset) +;; resolved pattern pos cannot be manipulated, unresolved can +;; the total input space size (define (pattern-count pattern) (for/fold ([sum 1]) ([p (in-vector pattern)]) (* sum (integer-set-count p)))) -(define (pattern-start pattern) - (for/vector ([iset (in-vector pattern)]) - (pos->integer-set-pos iset 0))) +;; takes an integer in the range [0, pattern-count) and produces and unresolved pattern pos +;; this allows using integer sets to reference parts of patterns +;; produces unresolved pattern pos +(define (pos->pattern-pos pattern pos) + (define rev-counts (reverse (for/list ([x (in-vector pattern)]) (integer-set-count x)))) -(define (pattern-end pattern) - (for/vector ([iset (in-vector pattern)]) - (pos->integer-set-pos iset (integer-set-count iset)))) + ;; bases in reverse order + (define (helper pos bases) + (cond + [(zero? pos) '()] + [(empty? bases) (error "overflowed pattern pos")] + [else + (define-values [q r] (quotient/remainder pos (first bases))) + (cons r (helper q (rest bases)))])) + + (define lower-pos (list->vector (reverse (helper pos rev-counts)))) + (vector-append (make-vector (- (vector-length pattern) (vector-length lower-pos)) 0) lower-pos)) + +;; unresolved -> resolved +(define (resolve-pattern-pos pattern pp) + (for/vector ([iset (in-vector pattern)] [pos (in-vector pp)]) + (pos->integer-set-pos iset pos)))