migrate to data/integer-set

crossfire/codegen.rkt

@@ -16,7 +16,8 @@
 ;; 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 racket/match racket/runtime-path
+(require (only-in data/integer-set integer-set-contents)
+         racket/match racket/runtime-path racket/vector
          scribble/text (rename-in scribble/text/output [output scribble-output]))
 
 (provide pattern-codegen)
@@ -43,7 +44,7 @@
 (define (pattern-codegen pattern mode pp-start pp-end)
   (eval-template
     `(file ,(path->string codegen-template))
-    (hash 'pattern pattern
+    (hash 'pattern (vector-map integer-set-contents pattern)
           'mode mode
           'pp-start pp-start
           'pp-end pp-end)))

crossfire/codegen.rktc

@@ -44,7 +44,7 @@ typedef struct {
   (define len (length iset))
   @list{iset @name = @"{" @len @"," @"{" @(add-between
       (for/list ([ival (in-list iset)])
-        @list{@"{" @car[ival] @"," @cdr[ival] @"}"})
+        @list{@"{" @car[ival] @"," @add1[@cdr[ival]] @"}"})
       ",") @"}}" ;
 
   })
@@ -93,7 +93,7 @@ l_inner:
     }
 
     @(match mode
-      ['stdout
+      ['stdio
        @list{ssize_t res = snprintf(buf, sizeof(buf), @(format "\"~a\\n\"" fmt), @vs );
              fwrite(buf, res, 1, stdout);}]
       ['callback
@@ -104,7 +104,7 @@ l_end:
     return 0;
 }
 
-@(if (equal? mode 'stdout)
+@(if (equal? mode 'stdio)
   @list{
 int main() {
     return crossfire_main(NULL);

crossfire/main.rkt

@@ -60,7 +60,7 @@
         [(list 'iset name val)
          (struct-copy manifest mf
                       [isets (hash-set (manifest-isets mf)
-                                         (symbol->string name) (string->iset val))])]
+                                         (symbol->string name) (string->integer-set val))])]
         [(list 'pattern pattern) (struct-copy manifest mf [pattern pattern])])))
 
   (check-false name)
@@ -71,7 +71,7 @@
   (define pattern
     (for/vector ([x (in-list (regexp-match* #rx"\\??." (manifest-pattern mf)))])
       (if (= 1 (string-length x))
-        (char->iset (string-ref x 0))
+        (char->integer-set (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))
 
@@ -81,9 +81,9 @@
 (define-values [name mode command pattern]
   (parse-manifest
     '((name "test")
-      (mode callback)
+      (mode stdio)
       (command ("meme"))
-      (pattern "test?d?a?a?s"))))
+      (pattern "?d_?d"))))
 
 (pattern-codegen pattern mode (pattern-start pattern) (pattern-end pattern))
 (printf "// total: ~a\n" (pattern-count pattern))

crossfire/pattern.rkt

@@ -16,109 +16,77 @@
 ;; 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 racket/list racket/match)
+(require (only-in data/integer-set make-integer-set integer-set-contents [union integer-set-union])
+         racket/list racket/match)
 
-(provide make-iset iset-add iset-count pos->iset-pos
+(provide integer-set-count pos->integer-set-pos
-         char->iset string->iset range->iset
+         char->integer-set string->integer-set range->integer-set
          builtin-isets
          pattern-count pattern-start pattern-end)
 
-;; TODO : replace with data/integer-set
-
 ;; pattern processing
+;; NOTE: data/integer-set WFS intervals are INCLUSIVE
 
-;; Iset is a listof Interval
+;; counts the total number of integers in the set
-;; Interval is a (cons start end) and represents [start, end)
+(define (integer-set-count iset)
-
+  (for/sum ([ival (in-list (integer-set-contents iset))])
-(define (make-iset) '())
+    (- (add1 (cdr ival)) (car ival))))
-
-(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
+;; 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
-(define (pos->iset-pos iset pos)
+(define (pos->integer-set-pos iset pos)
-  (define (helper iset pos)
+  (define (helper wfs pos)
-    (match-define (cons (cons fs fe) r) iset)
+    (match-define (cons (cons fs fe) r) wfs)
-    (define delta (- fe fs))
+    (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 (iset-count iset))
+  (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 iset (sub1 pos)))
+     (match-define (cons inum ival) (helper (integer-set-contents iset) (sub1 pos)))
      (cons inum (add1 ival))]
-    [else (helper iset pos)]))
+    [else (helper (integer-set-contents iset) pos)]))
 
-(define (char->iset ch)
+(define (char->integer-set ch)
-  (define cp (char->integer ch))
+  (define x (char->integer ch))
-  (iset-add (make-iset) cp (add1 cp)))
+  (make-integer-set `((,x . ,x))))
 
-(define (string->iset str)
+(define (string->integer-set str)
-  (for/fold ([iset (make-iset)]) ([ch (in-string str)])
+  (for/fold ([iset (make-integer-set '())]) ([ch (in-string str)])
-    (define cp (char->integer ch))
+    (integer-set-union iset (char->integer-set ch))))
-    (iset-add iset cp (add1 cp))))
 
-(define (range->iset a b)
+;; INCLUSIVE
-  (iset-add (make-iset) a b))
+(define (range->integer-set a b)
+  (make-integer-set `((,a . ,b))))
 
 (define builtin-isets
-  (hash "?l" (string->iset "abcdefghijklmnopqrstuvwxyz")
+  (hash "?l" (string->integer-set "abcdefghijklmnopqrstuvwxyz")
-        "?u" (string->iset "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+        "?u" (string->integer-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
-        "?d" (string->iset "0123456789")
+        "?d" (string->integer-set "0123456789")
-        "?s" (string->iset " !\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")
+        "?s" (string->integer-set " !\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")
-        "?a" (range->iset 32 127)
+        "?a" (range->integer-set 32 126)
-        "?b" (range->iset 0 256)))
+        "?b" (range->integer-set 0 255)))
 
 ;; a PatternPos is a vector of IsetPos
 
 (define (pattern-count pattern)
   (for/fold ([sum 1]) ([p (in-vector pattern)])
-    (* sum (iset-count p))))
+    (* sum (integer-set-count p))))
 
 (define (pattern-start pattern)
   (for/vector ([iset (in-vector pattern)])
-    (pos->iset-pos iset 0)))
+    (pos->integer-set-pos iset 0)))
 
 (define (pattern-end pattern)
   (for/vector ([iset (in-vector pattern)])
-    (pos->iset-pos iset (iset-count iset))))
+    (pos->integer-set-pos iset (integer-set-count iset))))

crossfire/protocol.rkt

@@ -173,14 +173,14 @@
   (require racket/cmdline)
   (current-db (open-server-db 'create))
   (migrate-server-db)
-  (define data (configure-agent-binary (node 10 "meow0" 'agent #f #f #f #f)
+  ; (define data (configure-agent-binary (node 10 "meow0" 'agent #f #f #f #f)
-                                       "aarch64-unknown-linux-gnu"
+  ;                                      "aarch64-unknown-linux-gnu"
-                                       (node 0 "server" 'server #f #f "meow.systems" 1337)))
+  ;                                      (node 0 "server" 'server #f #f "meow.systems" 1337)))
-  (with-output-to-file "/tmp/crossfire-agent.configured"
+  ; (with-output-to-file "/tmp/crossfire-agent.configured"
-    (lambda () (write-bytes data)))
+  ;   (lambda () (write-bytes data)))
   ; (make-node "agent0" "x86_64" 'agent '("gpu" "hifive"))
   ; (parameterize ([current-from-node (node 100 "meow" 'client #f #f #f #f)])
     ; ((rpc-impl server edit-agent) 1 "meow0" '("cpu" "hifive")))
   ; (get-nodes 'agent)
   ; (get-nodes 'meow)
-   )
+)