[chatter] r11789 - in trunk/gwydion/d2c/runtime/dylan: . tests
agent at mccarthy.opendylan.org
agent at mccarthy.opendylan.org
Tue Apr 29 08:56:43 CEST 2008
Author: agent
Date: Tue Apr 29 08:56:41 2008
New Revision: 11789
Modified:
trunk/gwydion/d2c/runtime/dylan/limited-collection.dylan
trunk/gwydion/d2c/runtime/dylan/tests/collections.dylan
Log:
Job: gd
* Fixed limited collection test cases.
* Fixed <simple-???-vector> types to work with map, etc. All tests pass.
* Added somewhat functional limited(<stretchy-vector>, ...).
Modified: trunk/gwydion/d2c/runtime/dylan/limited-collection.dylan
==============================================================================
--- trunk/gwydion/d2c/runtime/dylan/limited-collection.dylan (original)
+++ trunk/gwydion/d2c/runtime/dylan/limited-collection.dylan Tue Apr 29 08:56:41 2008
@@ -170,6 +170,11 @@
//=========================================================================
// We declare one subclass of <object-table> and override element-setter.
+// XXX - Note that the DRM doesn't say that
+// limited(<object-table>, of: <object) returns <simple-object-table> like
+// it does for limited(<simple-vector>, of: <object>). We can probably
+// remove the method below.
+
// limited(<object-table>, of: <object>)
define method make-limited-collection
(base-class :: type-union(singleton(<table>), singleton(<object-table>)),
@@ -251,7 +256,8 @@
end function process-simple-vector-keys;
// This is a slightly more intelligent version of limited-vector-class.
-// It defines types which are properly hooked into the runtime type model.
+// It uses <limited-collection-mixin> to define types which are properly
+// hooked into the runtime type model; limited-vector-class does not.
// We define methods on 'element-setter' and 'make-limited-collection' in
// another macro below.
// I nuked 'element-type' from this list, since we implement a general
@@ -266,8 +272,12 @@
sealed slot %elem :: ?element-type,
init-value: ?fill, init-keyword: fill:, sizer: size,
size-init-value: 0, size-init-keyword: size:;
+ inherited slot %limited-collection-type =
+ make(<limited-collection>, base-class: <simple-vector>,
+ of: ?element-type);
end class;
define sealed domain make (singleton(?name));
+ define sealed domain initialize (?name);
define sealed inline method element
(vec :: ?name, index :: <integer>,
#key default = $not-supplied)
@@ -343,8 +353,8 @@
=> (instance :: <simple-object-vector>)
let requested-size = process-simple-vector-keys(collection-type, size, fill);
// The DRM discussion of '<simple-object-vector>' and
- // 'limited(<simple-vector>, of: <object>)' on page 223
- // requires us to this exactly so.
+ // 'limited(<simple-vector>, of: <object>)' on page 223 requires us to
+ // return an instance of <simple-object-vector>.
apply(make, <simple-object-vector>,
size: requested-size, fill: fill,
supplied-keys);
@@ -434,3 +444,52 @@
size: requested-size, fill: fill,
supplied-keys);
end method make-limited-collection;
+
+
+//=========================================================================
+// Limited <stretchy-vector> Type
+//=========================================================================
+// <limited-stretchy-object-deque> is a subclass of <stretchy-vector> and
+// <limited-collection-mixin>. Its element method is standard, but we must
+// customize element-setter and make.
+
+define method make-limited-collection
+ (base-class :: singleton(<stretchy-vector>),
+ element-type :: <type>,
+ collection-type :: <limited-collection>,
+ #rest supplied-keys,
+ #key fill, #all-keys)
+ => (instance :: <limited-stretchy-object-vector>)
+ process-stretchy-vector-keys(collection-type, fill);
+ apply(make, <limited-stretchy-object-vector>,
+ collection-type: collection-type,
+ fill: fill, supplied-keys);
+end method;
+
+define class <limited-stretchy-object-vector>
+ (<stretchy-object-vector>, <limited-collection-mixin>)
+end class;
+
+define sealed domain make (singleton(<limited-stretchy-object-vector>));
+define sealed domain initialize (<limited-stretchy-object-vector>);
+
+// Implement the DRM rules (plus an extension) for handling keyword
+// arguments to 'make'.
+define function process-stretchy-vector-keys
+ (collection-type :: <limited-collection>, fill :: <object>)
+ => ()
+ if (~instance?(fill, collection-type.element-type))
+ error("Cannot fill %= with %=", collection-type, fill);
+ end if;
+end function;
+
+// This isn't especially efficient--we need to inline it and implement
+// a constant folder to get the element-type.
+define method element-setter
+ (new-value :: <object>, collection :: <limited-stretchy-object-vector>,
+ key :: <integer>, #next next-method)
+ => (element :: <object>)
+ check-type(new-value,
+ collection.%limited-collection-type.limited-element-type);
+ next-method();
+end method;
Modified: trunk/gwydion/d2c/runtime/dylan/tests/collections.dylan
==============================================================================
--- trunk/gwydion/d2c/runtime/dylan/tests/collections.dylan (original)
+++ trunk/gwydion/d2c/runtime/dylan/tests/collections.dylan Tue Apr 29 08:56:41 2008
@@ -198,26 +198,35 @@
let sequences = make(<stretchy-vector>);
let element-types = limited-collection-element-types(class);
for (element-type :: <type> in element-types)
+ // This originally used as to copy the source sequence into the limited
+ // sequence, which fails, because as for limited collections isn't defined
+ // by Gwydion Dylan. For one thing, it doesn't set a valid fill when it
+ // makes the limited sequence.
let type = limited(class, of: element-type);
- if (subtype?(<integer>, element-type))
- add!(sequences, as(type, range(from: 1, to: collection-size)))
- end;
- if (subtype?(<character>, element-type))
- add!(sequences,
- if (collection-size < size($default-string))
- as(type, copy-sequence($default-string, end: collection-size));
- else
- make(type, size: collection-size, fill: 'a');
- end)
- end;
- if (subtype?(<vector>, element-type))
- add!(sequences,
- if (collection-size < size($default-vectors))
- as(type, copy-sequence($default-vectors, end: collection-size));
- else
- make(type, size: collection-size, fill: #[]);
- end)
- end
+ let sequence = make(type, size: collection-size,
+ fill: limited-collection-fill-object(element-type));
+ let source-sequence =
+ select (element-type by
+ method (elem-type, sel-type) subtype?(sel-type, elem-type) end)
+ <integer> =>
+ range(from: 1, size: collection-size);
+ <character> =>
+ if (collection-size < size($default-string))
+ copy-sequence($default-string, end: collection-size);
+ else
+ make(<string>, size: collection-size, fill: 'a');
+ end;
+ <vector> =>
+ if (collection-size < size($default-vectors))
+ copy-sequence($default-vectors, end: collection-size);
+ else
+ make(<simple-vector>, size: collection-size, fill: #[]);
+ end;
+ end select;
+ for (i from 0 below source-sequence.size)
+ sequence[i] := source-sequence[i];
+ end for;
+ sequences := add!(sequences, sequence);
end;
// Only return one for size 0, because they are all the same
if (collection-size = 0)
@@ -323,6 +332,15 @@
#[]
end method limited-collection-element-types;
+define method limited-collection-fill-object
+ (element-type :: <type>) => (fill-object :: <object>)
+ select (element-type)
+ <integer> => 0;
+ <character> => 'x';
+ <vector> => #["fill"];
+ end select;
+end method;
+
define generic collection-default (type :: <type>) => (res);
define method collection-default (type :: <class>) => (res)
More information about the chatter
mailing list