refactor pattern: track pattern ranges using integers

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:

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)
+  (values (manifest-name mf) (manifest-arch mf) (manifest-resources mf) (manifest-mode mf)
-          (apply vector-append patterns)))
+          (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))

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 <https://www.gnu.org/licenses/>.
 
-(require (only-in data/integer-set make-integer-set integer-set-contents [union integer-set-union])
+(require (only-in data/integer-set make-integer-set integer-set-contents [union integer-set-union]
-         racket/list racket/match)
+                  [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)
+    (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))))
+           (cons (add1 inum) val)))]
-  (define cnt (integer-set-count iset))
+      [_ (error "iset-pos out of range" iset pos)]))
-  (cond
+
-    [(> pos cnt) (error "iset-pos out of range" iset pos)]
+  (helper (integer-set-contents 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)]))
 
 (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)
+;; takes an integer in the range [0, pattern-count) and produces and unresolved pattern pos
-  (for/vector ([iset (in-vector pattern)])
+;; this allows using integer sets to reference parts of patterns
-    (pos->integer-set-pos iset 0)))
+;; 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)
+  ;; bases in reverse order
-  (for/vector ([iset (in-vector pattern)])
+  (define (helper pos bases)
-    (pos->integer-set-pos iset (integer-set-count iset))))
+    (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)))