123 lines
3.8 KiB
Racket
123 lines
3.8 KiB
Racket
#lang racket/base
|
|
;; crossfire: distributed brute force infrastructure
|
|
;;
|
|
;; Copyright (C) 2020 haskal
|
|
;;
|
|
;; This program is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU Affero General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU Affero General Public License for more details.
|
|
;;
|
|
;; 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)
|
|
|
|
(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))))
|