Update to new bitsyntax extension interface.

codec.rkt

@@ -68,8 +68,7 @@
 ;;   (bit-string (vals :: (t:ntimes bits 32)))
 (define-syntax t:ntimes
   (syntax-rules ()
-    ((_ #t times-to-repeat option ...)
+    ((_ #t input ks kf times-to-repeat option ...)
-     (lambda (input ks kf)
      (let loop ((count times-to-repeat)
 		(acc '())
 		(input input))
@@ -78,9 +77,9 @@
 			     ([ (v :: option ...) (rest :: binary) ]
 			      (loop (- count 1) (cons v acc) rest))
 			     (else (kf))))
-	  (else (ks (reverse acc) input))))))
+	(else (ks (reverse acc) input)))))
-    ((_ #f option ...)
+    ((_ #f vs option ...)
-     (t:listof #f option ...))))
+     (t:listof #f vs option ...))))
 
 ;; Bit-syntax type for repeats of a value until no more input available.
 ;; Example: List of 32-bit unsigned words:
@@ -88,8 +87,7 @@
 ;;   (bit-string (vals :: (t:listof bits 32)))
 (define-syntax t:listof
   (syntax-rules ()
-    ((_ #t option ...)
+    ((_ #t input ks kf option ...)
-     (lambda (input ks kf)
      (let loop ((acc '())
 		(input input))
        (bit-string-case input
@@ -98,14 +96,13 @@
 	 ([]
 	  (ks (reverse acc) #""))
 	 (else
-	    (kf))))))
+	  (kf)))))
-    ((_ #f option ...)
+    ((_ #f vs option ...)
-     (lambda (vs)
      (let loop ((vs vs))
        (cond
 	((pair? vs) (bit-string ((car vs) :: option ...)
 				((loop (cdr vs)) :: binary)))
-	  (else (bit-string))))))))
+	(else (bit-string)))))))
 
 ;; <rfc1035>
 ;; All communications inside of the domain protocol are carried in a single
@@ -206,18 +203,18 @@
 ;;   (bit-string (v :: (t:named-bit 'zero 'one)))
 (define-syntax t:named-bit
   (syntax-rules ()
-    ((_ #t name0 name1) (lambda (input ks kf)
+    ((_ #t input ks kf name0 name1)
      (bit-string-case input
        ([ (v :: bits 1) (rest :: binary) ]
 	(ks (if (zero? v) name0 name1) rest))
-			    (else (kf)))))
+       (else (kf))))
-    ((_ #f name0 name1) (lambda (v)
+    ((_ #f v name0 name1)
      (cond
       ((eq? v name1) (bit-string (1 :: bits 1)))
       ((eq? v name0) (bit-string (0 :: bits 1)))
       (else (error 't:named-bit
 		   "Value supplied is neither ~v nor ~v: ~v"
-					name0 name1 v)))))))
+		   name0 name1 v))))))
 
 ;; Bit-syntax type for a DomainName. When decoding (but not when
 ;; encoding!), we support DNS's weird compressed domain-name syntax;
@@ -225,12 +222,11 @@
 ;; let it refer to random substrings within the packet.
 (define-syntax t:domain-name
   (syntax-rules ()
-    ((_ #t whole-packet)
+    ((_ #t input ks kf whole-packet)
-     (lambda (input ks kf)
      (let-values (((name rest) (parse-domain-name whole-packet input '())))
-	 (ks (domain name) rest))))
+       (ks (domain name) rest)))
-    ((_ #f)
+    ((_ #f val)
-     encode-domain-name)))
+     (encode-domain-name val))))
 
 ;; DomainName -> Bitstring
 (define (encode-domain-name name)
@@ -272,20 +268,18 @@
 ;; the given maximum, an error is signalled.
 (define-syntax t:pascal-string
   (syntax-rules ()
-    ((_ #t)
+    ((_ #t input ks kf)
-     (lambda (input ks kf)
      (bit-string-case input
        ([ len (body :: binary bytes len) (rest :: binary) ]
 	(ks (bit-string->bytes body) rest))
-	 (else (kf)))))
+       (else (kf))))
-    ((_ #f)
+    ((_ #f s)
-     (t:pascal-string #f "Character-string" 256))
+     (t:pascal-string #f s "Character-string" 256))
-    ((_ #f string-kind length-limit)
+    ((_ #f s string-kind length-limit)
-     (lambda (s)
      (let ((len (bytes-length s)))
        (when (>= len length-limit)
 	 (error 't:pascal-string "~s too long: ~v" string-kind s))
-	 (bit-string len (s :: binary)))))))
+       (bit-string len (s :: binary))))))
 
 ;; <rfc1035>
 ;; The question section is used to carry the "question" in most queries,
@@ -309,8 +303,7 @@
 ;; whole packet because the question may contain nested domain-names.
 (define-syntax t:question
   (syntax-rules ()
-    ((_ #t whole-packet)
+    ((_ #t input ks kf whole-packet)
-     (lambda (input ks kf)
      (bit-string-case input
        ([ (qname :: (t:domain-name whole-packet))
 	  (qtype :: bits 16)
@@ -320,12 +313,11 @@
 		      (value->qtype qtype)
 		      (value->qclass qclass)
 		      #f)
-	      tail)))))
+	    tail))))
-    ((_ #f)
+    ((_ #f q)
-     (lambda (q)
      (bit-string ((question-name q) :: (t:domain-name))
 		 ((qtype->value (question-type q)) :: bits 16)
-		   ((qclass->value (question-class q)) :: bits 16))))))
+		 ((qclass->value (question-class q)) :: bits 16)))))
 
 ;; <rfc1035>
 ;; All RRs have the same top level format shown below:
@@ -356,11 +348,10 @@
 ;; packet because the RR may contain nested domain-names.
 (define-syntax t:rr
   (syntax-rules ()
-    ((_ #t whole-packet)
+    ((_ #t input ks kf whole-packet)
-     (lambda (input ks kf)
+     (decode-rr whole-packet input ks kf))
-       (decode-rr whole-packet input ks kf)))
+    ((_ #f rr)
-    ((_ #f)
+     (encode-rr rr))))
-     encode-rr)))
 
 ;; Bytes Bytes (RR Bytes -> A) ( -> A) -> A
 ;; Helper for t:rr.