modify binary-data-definer macro so that it accepts class names

New: define binary-data <foo> (<container-frame>) end;
Old: define binary-data foo (container-frame) end;

Author: hannesm

binary-data-definer-macro.dylan

@@ -227,22 +227,22 @@ define macro decoded-class-definer
 end;
 
 define macro gen-classes
-  { gen-classes(?:name; ?superframe:name) }
+  { gen-classes("<" ## ?:name; "<" ## ?superframe:name) }
  => { define inline method unparsed-class
-          (type :: subclass("<" ## ?name ## ">"))
-       => (class == "<unparsed-" ## ?name ## ">")
-        "<unparsed-" ## ?name ## ">"
+          (type :: subclass("<" ## ?name))
+       => (class == "<unparsed-" ## ?name)
+        "<unparsed-" ## ?name
       end;
 
       define inline method decoded-class
-          (type :: subclass("<" ## ?name ## ">"))
-       => (class == "<decoded-" ## ?name ## ">")
-        "<decoded-" ## ?name ## ">"
+          (type :: subclass("<" ## ?name))
+       => (class == "<decoded-" ## ?name)
+        "<decoded-" ## ?name
       end;
 
-      define class "<unparsed-" ## ?name ## ">" ("<" ## ?name ## ">", "<unparsed-" ## ?superframe ## ">")
+      define class "<unparsed-" ## ?name ("<" ## ?name, "<unparsed-" ## ?superframe)
         //sadly, inherited slots can't specify a type (and generate a warning if you try)
-        inherited slot cache /* :: "<" ## ?name ## ">" */ = make("<decoded-" ## ?name ## ">"),
+        inherited slot cache /* :: "<" ## ?name */ = make("<decoded-" ## ?name),
           init-keyword: cache:;
       end; }
 end;
@@ -266,6 +266,8 @@ define macro unparsed-frame-field-generator
         end;
       end;
 
+      ignore(?name);
+
       define inline method ?name ## "-setter"
           (value, mframe :: ?frame-type) => (res)
         mframe.cache.?name := value;
@@ -274,6 +276,9 @@ define macro unparsed-frame-field-generator
         assemble-field-into(frame-field.field, mframe, subsequence(mframe.packet, start: start-offset(frame-field)));
         value;
       end;
+
+      ignore(?name ## "-setter");
+
  }
 end;
 
@@ -307,6 +312,8 @@ define macro enum-frame-field-generator
         end;
       end;
 
+      ignore(?name);
+
       define inline method ?name ## "-setter"
           (value :: <symbol>, mframe :: "<decoded-" ## ?frame-type) => (res)
         let field = fields(mframe)[?field-index];
@@ -326,6 +333,9 @@ define macro enum-frame-field-generator
         let val :: <integer> = enum-field-symbol-to-int(field, value);
         ?name ## "-setter" (val, mframe)
       end;
+
+      ignore(?name ## "-setter");
+
  }
 end;
 
@@ -361,6 +371,7 @@ define method parse-frame-field
     //           frame-field.field.field-name, start, end-of-field, full-frame-size);
     end-of-field := full-frame-size;
   end;
+  //format-out(" calling subsequence with start %d end %d (frame-size %d, my-length %d)\n", start, end-of-field, full-frame-size, my-length);
   let (value, length)
     = parse-frame-field-aux(frame-field.field,
                             frame-field.frame,
@@ -564,28 +575,30 @@ define macro summary-generator
 end;
 
 define macro container-frame-constructor
-  { container-frame-constructor(?:name) }
+  { container-frame-constructor("<" ## ?:name ## ">") }
  => { define inline method ?name (#rest args)
         apply(make, "<" ## ?name ## ">", args)
-      end }
+      end;
+
+      ignore(?name); }
 end;
 
 define macro binary-data-definer
   { define ?attrs:* binary-data ?:name (?superprotocol:name)
       summary ?summary:* ;
       ?fields:*
     end }
- => { summary-generator("<" ## ?name ## ">"; ?summary);
+ => { summary-generator(?name; ?summary);
       define ?attrs binary-data ?name (?superprotocol) ?fields end; }
 
-  { define ?attrs:* binary-data ?:name (container-frame) end }
- => { define abstract class "<" ## ?name ## ">" (<container-frame>) end;
+  { define ?attrs:* binary-data "<" ## ?:name (<container-frame>) end }
+ => { define abstract class "<" ## ?name (<container-frame>) end;
 
-      define abstract class "<decoded-" ## ?name ## ">"
-        ("<" ## ?name ## ">", <decoded-container-frame>)
+      define abstract class "<decoded-" ## ?name
+        ("<" ## ?name, <decoded-container-frame>)
       end;
 
-      gen-classes(?name; container-frame); }
+      gen-classes("<" ## ?name; <container-frame>); }
 
   { define ?attrs:* binary-data ?:name (?superprotocol:name)
       over ?super:name ?magic:expression;
@@ -596,11 +609,11 @@ define macro binary-data-definer
       define method lookup-layer
           (frame :: subclass(?super), value == ?magic)
        => (class :: <class>)
-        "<" ## ?name ## ">"
+        ?name
       end;
 
       define method reverse-lookup-layer
-          (frame :: subclass(?super), payload :: "<" ## ?name ## ">")
+          (frame :: subclass(?super), payload :: ?name)
        => (value :: <integer>)
         ?magic
       end; }
@@ -612,25 +625,25 @@ define macro binary-data-definer
  => { define ?attrs binary-data ?name (?superprotocol) ?fields end;
 
       define inline method container-frame-size
-          (?=frame :: "<" ## ?name ## ">") => (res :: <integer>)
+          (?=frame :: ?name) => (res :: <integer>)
         ?container-frame-length
       end; }
 
-  { define ?attrs:* binary-data ?:name (?superprotocol:name)
+  { define ?attrs:* binary-data "<" ## ?:name ("<" ## ?superprotocol:name)
       ?fields:*
     end }
- => { real-class-definer(?attrs; "<" ## ?name ## ">"; "<" ## ?superprotocol ## ">"; ?fields);
+ => { real-class-definer(?attrs; "<" ## ?name; "<" ## ?superprotocol; ?fields);
 
-      decoded-class-definer("<decoded-" ## ?name ## ">";
-                            "<" ## ?name ## ">", "<decoded-" ## ?superprotocol ## ">";
+      decoded-class-definer("<decoded-" ## ?name;
+                            "<" ## ?name, "<decoded-" ## ?superprotocol;
                             ?fields);
 
-      gen-classes(?name; ?superprotocol);
+      gen-classes("<" ## ?name; "<" ## ?superprotocol);
 
-      frame-field-generator("<unparsed-" ## ?name ## ">";
-                            field-count("<unparsed-" ## ?superprotocol ## ">");
+      frame-field-generator("<unparsed-" ## ?name;
+                            field-count("<unparsed-" ## ?superprotocol);
                             ?fields);
 
-      container-frame-constructor(?name); }
+      container-frame-constructor("<" ## ?name); }
 end;
 

binary-data.dylan

@@ -71,8 +71,7 @@ define open generic parse-frame
 define method parse-frame
     (frame-type :: subclass(<frame>),
      packet :: <sequence>,
-     #rest rest,
-     #key, #all-keys)
+     #rest rest, #key)
  => (value :: <object>, next-unparsed :: <integer>);
  let packet-subseq = as(<stretchy-byte-vector-subsequence>, packet);
  apply(parse-frame, frame-type, packet-subseq, rest)

leaf-frames.dylan

@@ -77,9 +77,7 @@ define class <unsigned-byte> (<fixed-size-translated-leaf-frame>)
 end;
 
 define method parse-frame
-    (frame-type == <unsigned-byte>,
-     packet :: <byte-sequence>,
-     #key)
+    (frame-type == <unsigned-byte>, packet :: <byte-sequence>, #key)
  => (value :: <byte>, next-unparsed :: <integer>)
   values(packet[0], 8)
 end;
@@ -153,7 +151,8 @@ define n-bit-unsigned-integer(<20bit-unsigned-integer>; 20) end;
 
 define method parse-frame
     (frame-type :: subclass(<unsigned-integer-bit-frame>),
-     packet :: <byte-sequence>, #key)
+     packet :: <byte-sequence>,
+     #key)
  => (value :: <integer>, next-unparsed :: <integer>)
   let result-size = field-size(frame-type);
   let subseq = subsequence(packet, length: result-size);
@@ -211,10 +210,10 @@ end;
 
 define macro n-byte-vector-definer
   { define n-byte-vector(?:name, ?n:*) end }
-    => { define class "<" ## ?name ## ">" (<fixed-size-byte-vector-frame>)
+    => { define class ?name (<fixed-size-byte-vector-frame>)
          end;
 
-         define inline method field-size (type == "<" ## ?name ## ">")
+         define inline method field-size (type == ?name)
           => (length :: <integer>)
            ?n * 8
          end;
@@ -339,16 +338,16 @@ define method parse-frame
      packet :: <byte-sequence>,
      #key)
  => (value :: <integer>, next-unparsed :: <integer>)
- let result-size = byte-offset(field-size(frame-type));
- if (packet.size < result-size)
-   signal(make(<malformed-data-error>))
- else
-   let result = 0;
-   for (i from 0 below result-size)
-     result := packet[i] + ash(result, 8)
-   end;
-   values(result, result-size * 8)
- end;
+  let result-size = byte-offset(field-size(frame-type));
+  if (packet.size < result-size)
+    signal(make(<malformed-data-error>))
+  else
+    let result = 0;
+    for (i from 0 below result-size)
+      result := packet[i] + ash(result, 8)
+    end;
+    values(result, result-size * 8)
+  end;
 end;
 
 define method assemble-frame
@@ -550,7 +549,7 @@ end;
 
 
 define macro leaf-frame-constructor-definer
-  { define leaf-frame-constructor(?:name) end }
+  { define leaf-frame-constructor("<" ## ?:name ## ">") end }
  =>
   {
     define method ?name (data :: <byte-vector>)
@@ -572,8 +571,8 @@ define macro leaf-frame-constructor-definer
 end;
 
 //FIXME
-define n-byte-vector(little-endian-unsigned-integer-4byte, 4) end;
-define n-byte-vector(big-endian-unsigned-integer-4byte, 4) end;
+define n-byte-vector(<little-endian-unsigned-integer-4byte>, 4) end;
+define n-byte-vector(<big-endian-unsigned-integer-4byte>, 4) end;
 
 
 define function float-to-byte-vector-be (float :: <float>)