Update of /scm/cvs/src/d2c/runtime/dylan
In directory gauss.gwydiondylan.org:/tmp/cvs-serv73736
Modified Files:
Tag: gd-2-5-collection-optimization
string.dylan
Log Message:
job: 7094
added implementations of the as(<byte-string>, ...) method for the basic
collection classes
added implementations of
fill!
reverse
reverse!
remove
shallow-copy
for <byte-string>s
re-implemented copy-sequence for <byte-string>. Andreas I believe
changed the previous method to accept a start: greater than the end:,
which goes against the behavior of all Gwydion Dylan's other
copy-sequence methods, and the behavior of Functional Developer.
(Functional Developer allows a start: == to the end:, but not greater
than the end:)
Index: string.dylan
===================================================================
RCS file: /scm/cvs/src/d2c/runtime/dylan/string.dylan,v
retrieving revision 1.4.2.3.2.3
retrieving revision 1.4.2.3.2.4
diff -u -d -r1.4.2.3.2.3 -r1.4.2.3.2.4
--- string.dylan 13 Oct 2004 19:31:34 -0000 1.4.2.3.2.3
+++ string.dylan 14 Oct 2004 01:52:57 -0000 1.4.2.3.2.4
@@ -42,12 +42,12 @@
end;
define sealed inline method make (class == <string>, #key size = 0, fill = ' ')
- => res :: <string>;
+ => res :: <byte-string>;
make(<byte-string>, size: size, fill: fill);
end;
define sealed inline method as (class == <string>, collection :: <collection>)
- => res :: <string>;
+ => res :: <byte-string>;
as(<byte-string>, collection);
end;
@@ -237,20 +237,6 @@
define sealed domain make (singleton(<byte-string>));
-define sealed method as (class == <byte-string>, collection :: <collection>)
- => res :: <byte-string>;
- let res = make(<byte-string>, size: collection.size);
- for (index :: <integer> from 0, element in collection)
- res[index] := element;
- end;
- res;
-end;
-
-define inline method as (class == <byte-string>, string :: <byte-string>)
- => res :: <byte-string>;
- string;
-end;
-
define inline method element
(vec :: <byte-string>, index :: <integer>,
#key default = $not-supplied)
@@ -321,6 +307,162 @@
end);
end;
+define sealed inline method as (class == <byte-string>, string ::
<byte-string>)
+ => res :: <byte-string>;
+ string;
+end;
+
+define sealed method as
+ (class == <byte-string>, collection :: <collection>)
+ => res :: <byte-string>;
+ // We won't blindly trust that size(collection) returns a
+ // value consistent with the forward-iteration-protocol for
+ // the collection so let's be sure not to iterate past sz.
+ // (It's possible that a user-implemented collection class
+ // could be incorrect.)
+ // Also don't used the keyed-by clause here because it may be
+ // slow for the collection.
+ let sz :: <integer> = collection.size;
+ let res = make(<byte-string>, size: sz);
+ for (index :: <integer> from 0 below sz, elt :: <byte-character> in
collection)
+ %element(res, index) := elt;
+ end;
+ res;
+end method as;
+
+define sealed method as
+ (class == <byte-string>, vec :: <simple-object-vector>)
+ => res :: <byte-string>;
+ let res = make(<byte-string>, size: vec.size);
+ for (elt :: <byte-character> keyed-by index in vec)
+ %element(res, index) := elt;
+ end;
+ res;
+end method as;
+
+define sealed method as
+ (class == <byte-string>, list :: <list>)
+ => res :: <byte-string>;
+ let sz :: <integer> = list.size;
+ let res = make(<byte-string>, size: sz);
+ for (index :: <integer> from 0, elt :: <byte-character> in list)
+ %element(res, index) := elt;
+ end;
+ res;
+end method as;
+
+define sealed method as
+ (class == <byte-string>, ssv :: <stretchy-object-vector>)
+ => (res :: <byte-string>);
+ let sz = ssv.size;
+ let res = make(<byte-string>, size: sz);
+ let data = ssv.ssv-data;
+ for (index :: <integer> from 0 below sz)
+ %element(res, index) := check-type(%element(data, index),
<byte-character>);
+ end;
+ res;
+end;
+
+// Not strictly necessary, but produces slightly more optimal code
+//
+define inline method type-for-copy (object :: <byte-string>)
+ => (class :: <class>)
+ <byte-string>;
+end;
+
+// author: PDH
+define method fill!
+ (string :: <byte-string>, value :: <byte-character>,
+ #key start :: <integer> = 0, end: last :: false-or(<integer>))
+ => (string :: <byte-string>);
+ let last = check-start-end-bounds(fill!, string, start, last);
+ for (index from start below last)
+ %element(string, index) := value;
+ end;
+ string;
+end method;
+
+// author: PDH
+// This is essentially a specialized clone of the general method for sequences
+define method remove
+ (string :: <byte-string>, value :: <byte-character>,
+ #key test :: <function> = \==, count :: false-or(<integer>))
+ => (result :: <byte-string>);
+ for (elem in string,
+ result = #() then if ((count & (count <= 0))
+ | ~compare-using-default-==(test, elem, value))
+ pair(elem, result);
+ else
+ if (count) count := count - 1 end;
+ result;
+ end if)
+ finally
+ as(<byte-string>, reverse!(result));
+ end for;
+end method remove;
+
+// author: PDH, 5x speed-up
+define method reverse (string :: <byte-string>)
+ => (result :: <byte-string>)
+ let sz = string.size;
+ let result = make(<byte-string>, size: sz);
+ for (elt in string, reverse-index from (sz - 1) by -1)
+ %element(result, reverse-index) := elt;
+ end;
+ result;
+end method;
+
+// author: PDH, 50x speed-up
+define method reverse! (string :: <byte-string>)
+ => (result :: <byte-string>)
+ let sz = string.size;
+ let mid = ash(sz, -1);
+ for (left from 0 below mid, right from (sz - 1) by -1)
+ %swap-elements!(string, left, right);
+ end;
+ string;
+end method;
+
+// author: PDH, 4x speed-up
+define method copy-sequence
+ (source :: <byte-string>, #key start :: <integer> = 0, end: last ::
false-or(<integer>))
+ => (result :: <byte-string>);
+ let last = check-start-end-bounds(copy-sequence, source, start, last);
+ let dest-size = last - start;
+ let dest = make(<byte-string>, size: dest-size);
+ // use an empirically determined cut-off point to switch to memcpy
+ if (dest-size < $memcpy-switchover-point)
+ for (dest-index from 0 below dest-size, source-index from start)
+ %element(dest, dest-index) := %element(source, source-index);
+ end;
+ else
+ call-out("memcpy", void:,
+ ptr: vector-elements-address(dest),
+ ptr: vector-elements-address(source) + start,
+ int: dest-size);
+ end if;
+ dest;
+end method;
+
+// author: PDH, 5x speed-up
+define inline method shallow-copy (string :: <byte-string>)
+ => (result :: <byte-string>)
+ let sz :: <integer> = string.size;
+ let result = make(<byte-string>, size: sz);
+ // use an empirically determined cut-off point to switch to memcpy
+ if (sz < $memcpy-switchover-point)
+ for (elt keyed-by index in string)
+ %element(result, index) := elt;
+ end;
+ else
+ call-out("memcpy", void:,
+ ptr: vector-elements-address(result),
+ ptr: vector-elements-address(string),
+ int: sz);
+ end if;
+ result;
+end method;
+
// author: PDH, 1.5x speed-up
// For average-length strings, calling out to the C library function
// memcmp is slower than comparing entirely in Dylan.
@@ -417,22 +559,3 @@
result;
end if;
end method concatenate;
-
-define method copy-sequence
- (vector :: <byte-string>, #key start :: <integer> = 0, end: last ::
false-or(<integer>))
- => (result :: <byte-string>);
- let src-sz :: <integer> = size(vector);
- let last :: <integer>
- = if (last & last < src-sz) last else src-sz end if;
- let start :: <integer> = if (start < 0) 0 else start end if;
- let sz :: <integer> = last - start;
-
- if(start > last) sz := 0 end;
-
- let result :: <byte-string> = make(<byte-string>, size: sz);
- for (from-index :: <integer> from start below last,
- to-index :: <integer> from 0)
- %element(result, to-index) := %element(vector, from-index);
- end for;
- result;
-end method copy-sequence;
_______________________________________________
Gd-chatter mailing list
Gd-chatter@xxxxxxxxxxxxxxxx
https://gauss.gwydiondylan.org/mailman/listinfo/gd-chatter
|