implement manifest utilities

crossfire/manifest.rkt

@@ -16,7 +16,7 @@
 ;; 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
+(require racket/bool racket/contract racket/list racket/match racket/vector
          "pattern.rkt")
 
 ;; a manifest is a list of list with the following fields
@@ -48,73 +48,79 @@
         '?s (string->integer-set " !\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")
         '?a (range->integer-set 32 126)
         '?b (range->integer-set 0 255)))
+(provide builtin-isets)
+
+;; manifest contracts and definition
+(define (iset-sym? x)
+  (let ([y (symbol->string x)])
+    (and (> 0 (string-length y)) (char=? #\? (string-ref y 0)))))
+(define isub/c (or/c (list/c integer? integer?) (and/c symbol? iset-sym?) string?))
+(define manifest-def/c (listof (or/c
+                                 (list/c 'name string?)
+                                 (cons/c 'arch (listof string?))
+                                 (cons/c 'resources (listof string?))
+                                 (list/c 'smp boolean?)
+                                 (list/c 'mode (or/c 'stdio 'callback))
+                                 (cons/c 'command (listof string?))
+                                 (cons/c 'iset (listof isub/c))
+                                 (cons/c 'pattern (listof isub/c)))))
+
+(struct manifest [data pattern size] #:transparent)
+(provide (contract-out
+           [struct manifest ((data manifest-def/c)
+                             (pattern (vector/c integer-set?))
+                             (size integer?))]))
 
 
-; (define (parse-manifest manifest-def)
-;   (struct manifest [name arch resources smp mode command isets pattern] #:transparent)
-;
-;   (define-syntax (check-false stx)
-;     (syntax-case stx ()
-;       [(_ what)
-;        (with-syntax ([id (format-id stx "manifest-~a" #'what)]
-;                      [idsym #''what])
-;          #'(when (false? (id mf))
-;              (error "manifest attribute missing:" idsym)))]))
-;
-;   (define mf
-;     (for/fold ([mf (manifest #f '("any") '() #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 'smp smp) (struct-copy manifest mf [smp smp])]
-;         [(list 'mode mode) (struct-copy manifest mf [mode mode])]
-;         [(list 'command command) (struct-copy manifest mf [command command])]
-;         [(list 'iset name val)
-;          (struct-copy manifest mf
-;                       [isets (hash-set (manifest-isets mf) name (string->integer-set val))])]
-;         [(list 'pattern pattern ...) (struct-copy manifest mf [pattern pattern])])))
-;
-;   (check-false name)
-;   (check-false command)
-;   (check-false pattern)
-;
-;   (define isets (manifest-isets mf))
-;   (define (get-iset x)
-;     (hash-ref isets x (lambda () (error "no such iset defined" x))))
-;
-;   (define (parse-string-pattern ptn)
-;     (for/vector ([x (in-list (regexp-match* #rx"\\??." ptn))])
-;       (if (= 1 (string-length x))
-;         (char->integer-set (string-ref x 0))
-;         (get-iset (string->symbol x)))))
-;
-;   (define patterns
-;     (for/list ([x (in-list (manifest-pattern mf))])
-;       (match x
-;         [(? string?) (parse-string-pattern x)]
-;         [(? symbol?) (vector (get-iset x))]
-;         [(list start end) (vector (range->integer-set start end))]
-;         [_ (error "unrecognized pattern element in manifest" x)])))
-;
-;   (values (manifest-name mf) (manifest-arch mf) (manifest-resources mf) (manifest-smp mf)
-;           (manifest-mode mf) (manifest-command mf) (apply vector-append patterns)))
+;; this "parses" to the extent that is necessary to avoid unnecessary pattern computations
+;; the original data is stored, along with a flattened integer-set vector for the pattern and size
+;; field counting the pattern size
+(define/contract (parse-manifest manifest-def)
+  (-> manifest-def/c manifest?)
+  (define isets
+    (for/fold ([isets builtin-isets]) ([mf-el (in-list manifest-def)]
+                                       #:when (symbol=? 'iset (first mf-el)))
+      (hash-set
+        isets (second mf-el)
+        (for/fold ([iset (make-integer-set '())]) ([iset-el (in-list (cddr mf-el))])
+          (integer-set-union
+            iset (match iset-el
+                   [(list start end) (range->integer-set start end)]
+                   [(? symbol? sym) (hash-ref isets sym)]
+                   [(? string? str) (string->integer-set str)]
+                   [_ (error "unrecognized entry in iset" iset-el)]))))))
+  (define manifest-pattern
+    (let ([pattern-entry (assoc 'pattern manifest-def)])
+      (when (false? pattern-entry) (error "manifest needs a pattern"))
+      (rest pattern-entry)))
 
+  (define (get-iset x)
+    (hash-ref isets x (lambda () (error "no such iset defined" x))))
 
+  (define (parse-string-pattern ptn)
+    (for/vector ([x (in-list (regexp-match* #rx"\\??." ptn))])
+      (if (= 1 (string-length x))
+        (char->integer-set (string-ref x 0))
+        (get-iset (string->symbol x)))))
 
-; ;; test code
-;
-; (define-values [name arch resources smp mode command pattern]
-;   (parse-manifest
-;
-; (pattern-codegen pattern mode)
-; ;; inclusive range
-; (define start (resolve-pattern-pos pattern (pos->pattern-pos pattern 10)))
-; (define end (resolve-pattern-pos pattern (pos->pattern-pos pattern 21)))
-; (printf "// args: ")
-; (for ([s (in-vector start)] [e (in-vector end)])
-;   (apply printf "~a ~a ~a ~a "
-;          (map (lambda (x) (number->string x 16)) (list (car s) (cdr s) (car e) (cdr e)))))
-; (printf "\n")
-; (printf "// total: ~a\n" (pattern-count pattern))
+  (define patterns
+    (for/list ([x (in-list manifest-pattern)])
+      (match x
+        [(? string?) (parse-string-pattern x)]
+        [(? symbol?) (vector (get-iset x))]
+        [(list start end) (vector (range->integer-set start end))]
+        [_ (error "unrecognized pattern element in manifest" x)])))
+
+  (define pattern (apply vector-append patterns))
+  (define size (pattern-count pattern))
+  (manifest manifest-def pattern size))
+
+;; get data from the manifest
+(define/contract (manifest-data-get mf key [fail-thunk #f])
+  (->* (manifest? symbol?) (any/c) any)
+  (or (rest (assoc key (manifest-data mf)))
+      (and (procedure? fail-thunk) (fail-thunk))
+      fail-thunk))
+
+;; the struct contains the original data
+(define serialize-manifest manifest-data)

crossfire/pattern.rkt

@@ -16,15 +16,15 @@
 ;; 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]
-                  [count integer-set-count] [intersect integer-set-intersect]
-                  [subtract integer-set-subtract])
+(require (only-in data/integer-set make-integer-set integer-set-contents integer-set?
+                  [union integer-set-union] [count integer-set-count]
+                  [intersect integer-set-intersect] [subtract integer-set-subtract])
          racket/list racket/match racket/vector)
 
 (provide char->integer-set string->integer-set range->integer-set
          ;; re-export renamed integer-set accessors
          make-integer-set integer-set-contents integer-set-count integer-set-union
-         integer-set-intersect integer-set-subtract
+         integer-set-intersect integer-set-subtract integer-set?
          pattern-count pos->pattern-pos resolve-pattern-pos
          pattern-range-take)