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

migrate to data/integer-set

This commit is contained in:
xenia 2020-11-16 00:51:48 -05:00
parent f8d55f8a80
commit 64bbf52590
5 changed files with 51 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
crossfire/codegen.rkt
View File

@ -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)))

6
crossfire/codegen.rktc
View File

@ -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);

8
crossfire/main.rkt
View File

@ -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))

102
crossfire/pattern.rkt
View File

@ -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
char->iset string->iset range->iset
(provide integer-set-count pos->integer-set-pos
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
;; 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))))
;; 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
;; 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 (helper iset pos)
(match-define (cons (cons fs fe) r) iset)
(define delta (- fe fs))
(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 (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 cp (char->integer ch))
(iset-add (make-iset) cp (add1 cp)))
(define (char->integer-set ch)
(define x (char->integer ch))
(make-integer-set `((,x . ,x))))
(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 (string->integer-set str)
(for/fold ([iset (make-integer-set '())]) ([ch (in-string str)])
(integer-set-union iset (char->integer-set ch))))
(define (range->iset a b)
(iset-add (make-iset) a b))
;; INCLUSIVE
(define (range->integer-set a b)
(make-integer-set `((,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)))
(hash "?l" (string->integer-set "abcdefghijklmnopqrstuvwxyz")
"?u" (string->integer-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"?d" (string->integer-set "0123456789")
"?s" (string->integer-set " !\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")
"?a" (range->integer-set 32 126)
"?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))))

12
crossfire/protocol.rkt
View File

@ -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)
"aarch64-unknown-linux-gnu"
(node 0 "server" 'server #f #f "meow.systems" 1337)))
(with-output-to-file "/tmp/crossfire-agent.configured"
(lambda () (write-bytes data)))
; (define data (configure-agent-binary (node 10 "meow0" 'agent #f #f #f #f)
; "aarch64-unknown-linux-gnu"
; (node 0 "server" 'server #f #f "meow.systems" 1337)))
; (with-output-to-file "/tmp/crossfire-agent.configured"
; (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)
)
)