[Gd-chatter] r11148 - in trunk: fundev/sources/lib/collection-extensions fundev/sources/registry/generic src/common/collection-extensions src/common/regular-expressions src/common/string-ext src/d2c/compiler/main src/d2c/dig src/tests
prom at gwydiondylan.org
prom at gwydiondylan.org
Thu Jan 25 15:50:36 CET 2007
Author: prom
Date: Thu Jan 25 15:50:31 2007
New Revision: 11148
Added:
trunk/fundev/sources/lib/collection-extensions/gd-collection-extensions.lid (contents, props changed)
trunk/fundev/sources/lib/collection-extensions/od-collection-extensions.lid (contents, props changed)
trunk/src/common/collection-extensions/collection-utils.dylan (contents, props changed)
trunk/src/common/collection-extensions/gd-collection-extensions.lid (contents, props changed)
trunk/src/common/collection-extensions/od-collection-extensions.lid (contents, props changed)
Removed:
trunk/fundev/sources/lib/collection-extensions/collection-extensions.lid
trunk/src/common/collection-extensions/CollExt.lid
trunk/src/common/collection-extensions/fd-collection-extensions.lid
Modified:
trunk/fundev/sources/lib/collection-extensions/heap.dylan
trunk/fundev/sources/lib/collection-extensions/library.dylan
trunk/fundev/sources/lib/collection-extensions/sequence-utils.dylan
trunk/fundev/sources/lib/collection-extensions/strsearch.dylan
trunk/fundev/sources/lib/collection-extensions/subseq.dylan
trunk/fundev/sources/registry/generic/collection-extensions
trunk/src/common/collection-extensions/Makegen
trunk/src/common/collection-extensions/library.dylan
trunk/src/common/collection-extensions/sde-vector.dylan
trunk/src/common/collection-extensions/sequence-diff.dylan
trunk/src/common/collection-extensions/sequence-utils.dylan
trunk/src/common/collection-extensions/solist.dylan
trunk/src/common/collection-extensions/subseq.dylan
trunk/src/common/collection-extensions/vecsearch.dylan
trunk/src/common/regular-expressions/Makegen
trunk/src/common/string-ext/Makegen
trunk/src/d2c/compiler/main/Makegen
trunk/src/d2c/dig/Makegen
trunk/src/tests/Makegen
Log:
Job: minor
Merged almost all of collection-extensions.
Whats missing are the copy-down-methods used by the OD version and the testsuite.
Added: trunk/fundev/sources/lib/collection-extensions/gd-collection-extensions.lid
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/lib/collection-extensions/gd-collection-extensions.lid Thu Jan 25 15:50:31 2007
@@ -0,0 +1,10 @@
+Library: collection-extensions
+Files: library
+ collection-utils
+ solist
+ subseq
+ vecsearch
+ sde-vector
+ sequence-diff
+ sequence-utils
+
Modified: trunk/fundev/sources/lib/collection-extensions/heap.dylan
==============================================================================
--- trunk/fundev/sources/lib/collection-extensions/heap.dylan (original)
+++ trunk/fundev/sources/lib/collection-extensions/heap.dylan Thu Jan 25 15:50:31 2007
@@ -562,3 +562,4 @@
end method
);
end method random-iteration-protocol;
+
Modified: trunk/fundev/sources/lib/collection-extensions/library.dylan
==============================================================================
--- trunk/fundev/sources/lib/collection-extensions/library.dylan (original)
+++ trunk/fundev/sources/lib/collection-extensions/library.dylan Thu Jan 25 15:50:31 2007
@@ -39,8 +39,9 @@
use dylan;
use common-dylan, import: { byte-vector };
export heap, self-organizing-list, vector-search, subseq, sequence-diff;
- export SDE-vector;
- export collection-utilities, sequence-utilities;
+ export sde-vector;
+ export collection-utilities;
+ export sequence-utilities;
end library collection-extensions;
define module self-organizing-list
Added: trunk/fundev/sources/lib/collection-extensions/od-collection-extensions.lid
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/lib/collection-extensions/od-collection-extensions.lid Thu Jan 25 15:50:31 2007
@@ -0,0 +1,11 @@
+library: collection-extensions
+Target-Type: dll
+Files: library
+ collection-utils
+ solist
+ subseq
+ vecsearch
+ sde-vector
+ sequence-diff
+ sequence-utils
+
Modified: trunk/fundev/sources/lib/collection-extensions/sequence-utils.dylan
==============================================================================
--- trunk/fundev/sources/lib/collection-extensions/sequence-utils.dylan (original)
+++ trunk/fundev/sources/lib/collection-extensions/sequence-utils.dylan Thu Jan 25 15:50:31 2007
@@ -8,6 +8,7 @@
// =========
// Copyright (C) 1998-2004 Matthias Hölzl.
+// Copyright (C) 1998 Way Forward Technologies.
// Use and copying of this software and preparation of derivative
// works based on this software are permitted, including commercial
Modified: trunk/fundev/sources/lib/collection-extensions/strsearch.dylan
==============================================================================
--- trunk/fundev/sources/lib/collection-extensions/strsearch.dylan (original)
+++ trunk/fundev/sources/lib/collection-extensions/strsearch.dylan Thu Jan 25 15:50:31 2007
@@ -1,5 +1,4 @@
module: string-search
-rcs-header: $Header&
author: Robert Stockton (rgs at cs.cmu.edu)
synopsis: Provides a small assortment of specialized operations for
searching and modifying <vector>s and <byte-string>s. These
@@ -215,3 +214,4 @@
big;
end if;
end method replace-substring;
+
Modified: trunk/fundev/sources/lib/collection-extensions/subseq.dylan
==============================================================================
--- trunk/fundev/sources/lib/collection-extensions/subseq.dylan (original)
+++ trunk/fundev/sources/lib/collection-extensions/subseq.dylan Thu Jan 25 15:50:31 2007
@@ -133,7 +133,7 @@
constant slot current-elem-sttr, required-init-keyword: elem-setter:;
constant slot copy-state, required-init-keyword: copy:;
end class;
-
+
define method subsequence(seq :: <sequence>,
#key start: first = 0,
end: last) => (result ::
Modified: trunk/fundev/sources/registry/generic/collection-extensions
==============================================================================
--- trunk/fundev/sources/registry/generic/collection-extensions (original)
+++ trunk/fundev/sources/registry/generic/collection-extensions Thu Jan 25 15:50:31 2007
@@ -1 +1 @@
-abstract://dylan/lib/collection-extensions/collection-extensions.lid
\ No newline at end of file
+abstract://dylan/lib/collection-extensions/od-collection-extensions.lid
Modified: trunk/src/common/collection-extensions/Makegen
==============================================================================
--- trunk/src/common/collection-extensions/Makegen (original)
+++ trunk/src/common/collection-extensions/Makegen Thu Jan 25 15:50:31 2007
@@ -1,8 +1,13 @@
&makegen_include("../common-Makegen");
-$D2CFLAGS = $d2c_runtime;
+$D2CFLAGS # added by update-libdirs
+ = $d2c_runtime
+ . ' -L../common-dylan'
+ . ' -L../table-ext'
+ . ' -L../../d2c/runtime/random'
+ . ' -L../../d2c/runtime/threads';
do emit_library_rule(
- 'CollExt', '$(BUILDROOT)/force.timestamp', '', 'compile',
+ 'gd-collection-extensions', '$(BUILDROOT)/force.timestamp', '', 'compile',
'install'
);
Added: trunk/src/common/collection-extensions/collection-utils.dylan
==============================================================================
--- (empty file)
+++ trunk/src/common/collection-extensions/collection-utils.dylan Thu Jan 25 15:50:31 2007
@@ -0,0 +1,63 @@
+module: Collection-Utilities
+author: Matthias Hölzl (tc at xantira.com)
+copyright: see below
+version: 0.1 10 Apr 2004
+synopsis: This Module implements some useful methods on collections.
+
+// Copyright.
+// =========
+
+// Copyright (C) 1998-2004 Dr. Matthias Hölzl.
+
+// Use and copying of this software and preparation of derivative
+// works based on this software are permitted, including commercial
+// use, provided that the following conditions are observed:
+//
+// 1. This copyright notice must be retained in full on any copies
+// and on appropriate parts of any derivative works. (Other names
+// and years may be added, so long as no existing ones are removed.)
+//
+// This software is made available "as is". Neither the authors nor
+// Carnegie Mellon University make any warranty about the software,
+// its performance, or its conformity to any specification.
+//
+// Bug reports, questions, comments, and suggestions should be sent by
+// E-mail to the Internet address "gd-bugs at gwydiondylan.org".
+
+// If you need to receive this library under another license contact
+// the author (tc at xantira.com).
+
+
+// SINGLETON? -- check whether ARG is a collection with a single
+// element.
+//
+define open generic singleton?
+ (collection :: <collection>) => singleton? :: <boolean>;
+
+define method singleton?
+ (collection :: <collection>) => singleton? :: <boolean>;
+ collection.size = 1;
+end method singleton?;
+
+define sealed method singleton?
+ (list :: <pair>) => singleton? :: <boolean>;
+ empty?(tail(list));
+end method singleton?;
+
+define sealed method singleton?
+ (list :: <empty-list>) => false :: <boolean>;
+ #f;
+end method singleton?;
+
+define constant $not-found = pair(#f, #f);
+
+define method key-exists?
+ (collection :: <collection>, key)
+ => (key-exists? :: <boolean>, value :: <object>);
+ let result = element(collection, key, default: $not-found);
+ if (result)
+ values(#t, result);
+ else
+ values(#f, result);
+ end if;
+end method key-exists?;
Added: trunk/src/common/collection-extensions/gd-collection-extensions.lid
==============================================================================
--- (empty file)
+++ trunk/src/common/collection-extensions/gd-collection-extensions.lid Thu Jan 25 15:50:31 2007
@@ -0,0 +1,10 @@
+Library: collection-extensions
+Files: library
+ collection-utils
+ solist
+ subseq
+ vecsearch
+ sde-vector
+ sequence-diff
+ sequence-utils
+
Modified: trunk/src/common/collection-extensions/library.dylan
==============================================================================
--- trunk/src/common/collection-extensions/library.dylan (original)
+++ trunk/src/common/collection-extensions/library.dylan Thu Jan 25 15:50:31 2007
@@ -37,8 +37,11 @@
define library collection-extensions
use dylan;
+ use common-dylan, import: { byte-vector };
export heap, self-organizing-list, vector-search, subseq, sequence-diff;
- export Sequence-Utilities;
+ export sde-vector;
+ export collection-utilities;
+ export sequence-utilities;
end library collection-extensions;
define module self-organizing-list
@@ -49,7 +52,8 @@
define module subseq
use dylan;
- export subsequence, <subsequence>;
+ use byte-vector;
+ export subsequence, <subsequence>, <byte-vector-subsequence>;
end module subseq;
define module vector-search
@@ -84,8 +88,14 @@
element-count, source-index, dest-index;
end module sequence-diff;
-define module Sequence-Utilities
- use Dylan;
+define module collection-utilities
+ use dylan;
+ export singleton?, key-exists?;
+end module collection-utilities;
+
+define module sequence-utilities
+ use dylan;
+ export push!, pop!;
export pair?, null?, list?;
export xpair, tabulate, list*, take, drop, last-pair;
export reverse-append, unfold, unfold/tail;
@@ -93,5 +103,7 @@
export reduce-l, reduce-r, heads, tails;
export concatenate-map, pair-do, choose-map;
export partition, assoc, apair, alist-copy, alist-delete;
- export satisfies, index, find, find-tail, precedes?
-end module Sequence-Utilities;
\ No newline at end of file
+ export satisfies, index, find, find-tail, precedes?;
+ export split-at;
+end module sequence-utilities;
+
Added: trunk/src/common/collection-extensions/od-collection-extensions.lid
==============================================================================
--- (empty file)
+++ trunk/src/common/collection-extensions/od-collection-extensions.lid Thu Jan 25 15:50:31 2007
@@ -0,0 +1,11 @@
+library: collection-extensions
+Target-Type: dll
+Files: library
+ collection-utils
+ solist
+ subseq
+ vecsearch
+ sde-vector
+ sequence-diff
+ sequence-utils
+
Modified: trunk/src/common/collection-extensions/sde-vector.dylan
==============================================================================
--- trunk/src/common/collection-extensions/sde-vector.dylan (original)
+++ trunk/src/common/collection-extensions/sde-vector.dylan Thu Jan 25 15:50:31 2007
@@ -100,12 +100,12 @@
method (v :: <sde-vector>, state :: <integer>)
=> current-elt :: <object>;
- v.contents[state];
+ v.contents[get-index(state)];
end method,
method (val :: <object>, v :: <sde-vector>, state :: <integer>)
=> val :: <object>;
- v.contents[state] := val;
+ v.contents[get-index(state)] := val;
end method,
method (v :: <sde-vector>, state :: <integer>)
@@ -113,3 +113,4 @@
state;
end method);
end method forward-iteration-protocol;
+
Modified: trunk/src/common/collection-extensions/sequence-diff.dylan
==============================================================================
--- trunk/src/common/collection-extensions/sequence-diff.dylan (original)
+++ trunk/src/common/collection-extensions/sequence-diff.dylan Thu Jan 25 15:50:31 2007
@@ -42,19 +42,19 @@
define abstract class <script-entry> (<object>)
slot element-count, init-value: 1, init-keyword: #"count";
- slot dest-index, required-init-keyword: #"dest-index";
+ constant slot dest-index, required-init-keyword: #"dest-index";
end class <script-entry>;
// Inserts immediately after dest-start
//
define class <insert-entry> (<script-entry>)
- slot source-index, required-init-keyword: #"source-index";
+ constant slot source-index, required-init-keyword: #"source-index";
end class <insert-entry>;
define class <delete-entry> (<script-entry>)
end class <delete-entry>;
-// Returns themin(index such that seq1[index + 1] ~= seq2[index + 1]
+// Returns the min(index such that seq1[index + 1] ~= seq2[index + 1]
// -1 if seq1[0] ~= seq2[0]
//
define method last-common-elt (seq1 :: <sequence>, seq2 :: <sequence>)
@@ -84,7 +84,16 @@
if (lower > upper) // sequences are identical
return(#());
end if;
-
+ if (lower = 1 & upper = 1)
+ return(list(make(<insert-entry>,
+ source-index: row,
+ dest-index: row,
+ count: seq2.size - row)));
+ elseif (lower = -1 & upper = -1)
+ return(list(make(<delete-entry>,
+ dest-index: row,
+ count: seq1.size - row)))
+ end;
// For each diagonal k, last-distance[k] is the last row that
// contains the desired distance.
//
@@ -181,3 +190,4 @@
(s1 :: <sequence>, s2 :: <sequence>) => script :: <script>;
merge-dups(internal-diff(s1, s2));
end method sequence-diff;
+
Modified: trunk/src/common/collection-extensions/sequence-utils.dylan
==============================================================================
--- trunk/src/common/collection-extensions/sequence-utils.dylan (original)
+++ trunk/src/common/collection-extensions/sequence-utils.dylan Thu Jan 25 15:50:31 2007
@@ -1,15 +1,13 @@
module: Sequence-Utilities
-author: Matthias Hölzl (tc at gauss.muc.de)
+author: Matthias Hölzl (tc at xantira.com)
copyright: see below
-version: 0.01 19 Dec 1998
-synopsis: This Module implements some useful methods on collections.
+version: 0.1 10 Apr 2004
+synopsis: This Module implements some useful methods on sequences.
// Copyright.
// =========
-// Useful methods on collections.
-
-// Copyright (C) 1998 Matthias Hölzl.
+// Copyright (C) 1998-2004 Matthias Hölzl.
// Copyright (C) 1998 Way Forward Technologies.
// Use and copying of this software and preparation of derivative
@@ -28,7 +26,23 @@
// E-mail to the Internet address "gd-bugs at gwydiondylan.org".
// If you need to receive this library under another license contact
-// the author (tc at gauss.muc.de).
+// the author (tc at xantira.com).
+
+// PUSH! -- add an element to the front of a list.
+//
+define macro push!
+ { push!(?location:expression, ?value:expression) }
+ => { ?location := pair(?value, ?location) }
+end macro push!;
+
+// POP! -- remove the first element of a list.
+//
+define macro pop!
+ { pop!(?location:expression) }
+ => { let tmp = head(?location);
+ ?location := tail(?location);
+ tmp }
+end macro pop!;
// PAIR? -- check wether ARG is a pair.
//
@@ -574,3 +588,26 @@
not-found;
end block;
end method precedes?;
+
+// SPLIT-AT -- split a sequence at a token.
+//
+define function split-at
+ (sequence :: <sequence>, token, #key test = \=)
+ => split-sequence :: <sequence>;
+ let result = make(<stretchy-vector>);
+ let current-item = make(<stretchy-vector>);
+ for (elt in sequence)
+ if (test(elt, token))
+ add!(result, current-item);
+ current-item := make(<stretchy-vector>);
+ else
+ add!(current-item, elt);
+ end if;
+ finally
+ // Add the last part. If the line ends with Token we add
+ // an empty sequence.
+ add!(result, current-item);
+ end for;
+ result;
+end function split-at;
+
Modified: trunk/src/common/collection-extensions/solist.dylan
==============================================================================
--- trunk/src/common/collection-extensions/solist.dylan (original)
+++ trunk/src/common/collection-extensions/solist.dylan Thu Jan 25 15:50:31 2007
@@ -66,42 +66,42 @@
define sealed domain make (singleton(<self-organizing-list>));
define sealed domain initialize (<self-organizing-list>);
-define inline method sol-fip-next-state
+define inline function sol-fip-next-state
(list :: <self-organizing-list>, state :: <list>)
=> (result :: <list>);
tail(state);
-end method;
+end function;
-define inline method sol-fip-finished-state?
+define inline function sol-fip-finished-state?
(list :: <self-organizing-list>, state :: <list>, limit)
=> result :: <boolean>;
state == #();
-end method;
+end function;
-define inline method sol-fip-current-key
+define inline function sol-fip-current-key
(list :: <self-organizing-list>, state :: <list>)
=> (result :: <object>);
head(head(state));
-end method;
+end function;
-define inline method sol-fip-current-element
+define inline function sol-fip-current-element
(list :: <self-organizing-list>, state :: <list>)
=> (result :: <object>);
tail(head(state));
-end method;
+end function;
-define inline method sol-fip-current-element-setter
+define inline function sol-fip-current-element-setter
(value :: <object>, list :: <self-organizing-list>, state :: <list>)
=> (result :: <object>);
tail(head(state)) := value;
-end method;
+end function;
-define inline method sol-fip-copy-state
+define inline function sol-fip-copy-state
(list :: <self-organizing-list>, state :: <list>)
=> (result :: <list>);
state;
-end method;
+end function;
define sealed inline method forward-iteration-protocol
(table :: <self-organizing-list>)
@@ -124,20 +124,19 @@
// for which test(elem, key) is true, and then return the pair which
// *precedes* that element (or #() if not found)
//
-define constant elem-search
- = method (prev :: <list>, test :: <function>, key)
- let list = prev.tail;
- if (list == #())
- #();
- else
- let elem = list.head;
- if (test(elem.head, key))
- prev;
- else
- elem-search(list, test, key);
- end if;
- end if;
- end method;
+define function elem-search (prev :: <list>, test :: <function>, key)
+ let list = prev.tail;
+ if (list == #())
+ #();
+ else
+ let elem = list.head;
+ if (test(elem.head, key))
+ prev;
+ else
+ elem-search(list, test, key);
+ end if;
+ end if;
+end function elem-search;
define method element(table :: <self-organizing-list>, key :: <object>,
#key default: default = sol-no-default)
Modified: trunk/src/common/collection-extensions/subseq.dylan
==============================================================================
--- trunk/src/common/collection-extensions/subseq.dylan (original)
+++ trunk/src/common/collection-extensions/subseq.dylan Thu Jan 25 15:50:31 2007
@@ -9,7 +9,7 @@
//======================================================================
//
// Copyright (c) 1994 Carnegie Mellon University
-// Copyright (c) 1998, 1999, 2000 Gwydion Dylan Maintainers
+// Copyright (c) 1998 - 2004 Gwydion Dylan Maintainers
// All rights reserved.
//
// Use and copying of this software and preparation of derivative
@@ -80,12 +80,33 @@
// accessed at least once.
//============================================================================
+// Notes while reviewing the code ( -- andreas, 20050531)
+//
+// * Start and end are insufficiently checked. It is quite easy to generate
+// a subsequence of negative size by subsequence(foo, start: 5, end: 3).
+// * Also, passing a negative start gives access to data outside the
+// subsequence the user is allowed to see.
+// * The semantics of omitting the sequence end isn't well-defined,
+// especially given stretchy source sequences.
+// * The good news: the above problems are not exploitable because everything
+// is bounds-checked twice.
+// * The bad news: the performance leaves to be desired because everything
+// is bounds-checked twice.
+// * Design decision: signal bounds error at subsequence creation time vs.
+// element access time. The latter is more dynamic, the former gives
+// better performance.
+// * Feature wish: Read-only subsequences.
+
+
define abstract class <subsequence> (<sequence>)
- slot source :: <sequence>, required-init-keyword: source: ;
- slot start-index :: <integer>, required-init-keyword: start: ;
+ constant slot source :: <sequence>,
+ required-init-keyword: source: ;
+ constant slot start-index :: <integer>,
+ required-init-keyword: start: ;
// end-index is simply an upper bound, except in the case of
// <vector-subsequence>s.
- slot end-index :: <integer>, required-init-keyword: end: ;
+ constant slot end-index :: <integer>,
+ required-init-keyword: end: ;
end class <subsequence>;
define method subsequence(seq :: <subsequence>,
@@ -104,21 +125,20 @@
end method type-for-copy;
define class <generic-subsequence> (<subsequence>)
- slot init-state, required-init-keyword: init:;
- slot limit, required-init-keyword: limit:;
- slot next-state, required-init-keyword: next:;
- slot finished-state?, required-init-keyword: done:;
- slot current-elem, required-init-keyword: elem:;
- slot current-elem-sttr, required-init-keyword: elem-setter:;
- slot copy-state, required-init-keyword: copy:;
+ constant slot init-state, required-init-keyword: init:;
+ constant slot limit, required-init-keyword: limit:;
+ constant slot next-state, required-init-keyword: next:;
+ constant slot finished-state?, required-init-keyword: done:;
+ constant slot current-elem, required-init-keyword: elem:;
+ constant slot current-elem-sttr, required-init-keyword: elem-setter:;
+ constant slot copy-state, required-init-keyword: copy:;
end class;
define method subsequence(seq :: <sequence>,
#key start: first = 0,
end: last) => (result ::
<generic-subsequence>);
- let sz = size(seq);
- let subseq-last = if (last & last < sz) last else sz end if;
+ let subseq-last = if (last) last else max(first, seq.size) end if;
let (init, limit, next, done?,
key, elem, elem-setter, copy) = forward-iteration-protocol(seq);
let state = for (i from 0 below first,
@@ -152,31 +172,31 @@
copy: seq.copy-state);
end method subsequence;
-define constant gs-fip-next-state =
- method (c, s)
- head(s) := c.next-state(c.source, head(s));
- tail(s) := tail(s) + 1;
- s;
- end method;
-
-define constant gs-fip-done? =
- method (c, s, l)
- c.finished-state?(c.source, head(s), l) | tail(s) >= c.end-index;
- end method;
-
-define constant gs-fip-current-key =
- method (c, s) tail(s) - c.start-index end method;
-
-define constant gs-fip-current-element =
- method (c, s) c.current-elem(c.source, head(s)) end method;
-
-define constant gs-fip-current-element-setter =
- method (v, c, s)
- c.current-elem-sttr(v, c.source, head(s));
- end method;
-
-define constant gs-fip-copy-state =
- method (c, s) pair(c.copy-state(head(s)), tail(s)) end method;
+define inline function gs-fip-next-state (c :: <generic-subsequence>, s)
+ head(s) := c.next-state(c.source, head(s));
+ tail(s) := tail(s) + 1;
+ s;
+end function;
+
+define inline function gs-fip-done? (c :: <generic-subsequence>, s, l)
+ c.finished-state?(c.source, head(s), l) | tail(s) >= c.end-index;
+end function;
+
+define inline function gs-fip-current-key (c :: <generic-subsequence>, s)
+ tail(s) - c.start-index;
+end function;
+
+define inline function gs-fip-current-element (c :: <generic-subsequence>, s)
+ c.current-elem(c.source, head(s));
+end function;
+
+define inline function gs-fip-current-element-setter (v, c :: <generic-subsequence>, s)
+ c.current-elem-sttr(v, c.source, head(s));
+end function;
+
+define inline function gs-fip-copy-state (c :: <generic-subsequence>, s)
+ pair(c.copy-state(head(s)), tail(s));
+end function;
define method forward-iteration-protocol (seq :: <generic-subsequence>)
=> (initial-state :: <object>, limit :: <object>, next-state :: <function>,
@@ -191,6 +211,8 @@
define class <vector-subsequence> (<subsequence>, <vector>) end class;
define class <string-subsequence> (<subsequence>, <string>) end class;
+define class <byte-vector-subsequence> (<vector-subsequence>) end class;
+
// <vs-subsequence> is used for source sequences which are both <vector>s and
// <string>s. The only such predefined class is <byte-string>.
define class <vs-subsequence> (<string-subsequence>, <vector-subsequence>) end;
@@ -203,8 +225,7 @@
define method subsequence(seq :: <vector>,
#key start: first = 0,
end: last) => (result :: <vector-subsequence>);
- let seq-size = size(seq);
- let subseq-last = if (last) min(last, seq-size) else seq-size end;
+ let subseq-last = if (last) last else max(first, seq.size) end if;
if (instance?(seq, <string>))
make(<vs-subsequence>, source: seq, start: first, end: subseq-last);
else
@@ -212,35 +233,65 @@
end if;
end method subsequence;
-define constant vs-fip-next-element =
- method (c :: <subsequence>, s :: <integer>) => (result :: <integer>);
- s + 1;
- end method;
-
-define constant vs-fip-done? =
- method (c :: <subsequence>, s :: <integer>, l :: <integer>)
- s >= l;
- end method;
-
-define constant vs-fip-current-key =
- method (c :: <subsequence>, s :: <integer>) => (result :: <integer>);
- s - c.start-index;
- end method;
-
-define constant vs-fip-current-element =
- method (c :: <subsequence>, s :: <integer>)
- c.source[s];
- end method;
-
-define constant vs-fip-current-element-setter =
- method (e, c :: <subsequence>, s :: <integer>)
- c.source[s] := e;
- end method;
-
-define constant vs-fip-copy-state =
- method (c :: <subsequence>, s :: <integer>) => (result :: <integer>);
- s;
- end method;
+define method subsequence(seq :: <byte-vector>,
+ #key start: first = 0,
+ end: last) => (result :: <byte-vector-subsequence>);
+ let subseq-last = if (last) last else max(first, seq.size) end if;
+ make(<byte-vector-subsequence>, source: seq, start: first, end: subseq-last);
+end method subsequence;
+
+define sealed domain subsequence (<byte-vector-subsequence>);
+
+define method subsequence(seq :: <byte-vector-subsequence>,
+ #key start: first = 0,
+ end: last) => (result :: <byte-vector-subsequence>);
+ let subseq-last = if (last) last else max(first, seq.size) end if;
+ make(<byte-vector-subsequence>,
+ source: seq.source,
+ start: first + seq.start-index,
+ end: subseq-last + seq.start-index);
+end;
+
+define inline function vs-fip-next-element
+ (c :: <subsequence>, s :: <integer>) => (result :: <integer>);
+ s + 1;
+end function;
+
+define inline function vs-fip-done?
+ (c :: <subsequence>, s :: <integer>, l :: <integer>)
+ => (done :: <boolean>);
+ s >= l;
+end function;
+
+define inline function vs-fip-current-key
+ (c :: <subsequence>, s :: <integer>) => (result :: <integer>);
+ s - c.start-index;
+end function;
+
+define inline function vs-fip-current-element
+ (c :: <subsequence>, s :: <integer>) => (result :: <object>);
+ c.source[s];
+end function;
+
+define inline function vs-fip-current-element-setter
+ (e, c :: <subsequence>, s :: <integer>) => (result :: <object>)
+ c.source[s] := e;
+end function;
+
+define inline function byte-vector-fip-current-element
+ (c :: <byte-vector-subsequence>, s :: <integer>) => (result :: <byte>);
+ c.source[s];
+end function;
+
+define inline function byte-vector-fip-current-element-setter
+ (e :: <byte>, c :: <byte-vector-subsequence>, s :: <integer>) => (result :: <byte>)
+ c.source[s] := e;
+end function;
+
+define inline function vs-fip-copy-state
+ (c :: <subsequence>, s :: <integer>) => (result :: <integer>);
+ s;
+end function;
define method forward-iteration-protocol (seq :: <subsequence>)
=> (initial-state :: <object>, limit :: <object>, next-state :: <function>,
@@ -252,30 +303,42 @@
vs-fip-current-element-setter, vs-fip-copy-state);
end method forward-iteration-protocol;
-define method size(c :: <vector-subsequence>) => (result :: <integer>);
+define inline method forward-iteration-protocol (seq :: <byte-vector-subsequence>)
+ => (initial-state :: <object>, limit :: <object>, next-state :: <function>,
+ finished-state? :: <function>, current-key :: <function>,
+ current-element :: <function>, current-element-setter :: <function>,
+ copy-state :: <function>);
+ values(seq.start-index, seq.end-index, vs-fip-next-element, vs-fip-done?,
+ vs-fip-current-key, byte-vector-fip-current-element,
+ byte-vector-fip-current-element-setter, vs-fip-copy-state);
+end method forward-iteration-protocol;
+
+define inline method size(c :: <vector-subsequence>) => (result :: <integer>);
c.end-index - c.start-index;
end method size;
define method aref(c :: <vector-subsequence>,
#rest rest) => (result :: <object>);
let index = rest[0];
- if ((index < 0) | (index >= c.end-index - c.start-index))
+ if ((index < 0) | (index >= c.size))
signal("index out of bounds");
else
aref(c.source, index + c.start-index);
end if;
end method;
+
define method aref-setter(value, c :: <vector-subsequence>,
#rest rest) => (result :: <object>);
let index = rest[0];
- if ((index < 0) | (index >= c.end-index - c.start-index))
+ if ((index < 0) | (index >= c.size))
signal("index out of bounds");
else
aref(c.source, index + c.start-index) := value;
end if;
end method;
+
define method dimensions(c :: <vector-subsequence>) => (result :: <vector>);
vector(c.end-index - c.start-index);
end method;
@@ -284,32 +347,32 @@
define method element(seq :: <vector-subsequence>, key :: <integer>,
#key default = subseq-no-default) => elt :: <object>;
- let index = seq.start-index + key;
case
- key < 0 | index >= seq.end-index =>
+ key < 0 | key >= seq.size =>
if (default == subseq-no-default)
error("No such element in %=: %=", seq, key);
else
default
end if;
- otherwise => seq.source[index];
+ otherwise => seq.source[key + seq.start-index];
end case;
end method element;
+
define method element-setter(value, seq :: <vector-subsequence>,
key :: <integer>) => (result :: <object>);
case
- key < 0 | key >= seq.end-index - seq.start-index =>
+ key < 0 | key >= seq.size =>
error("No such element in %=: %=", seq, key);
otherwise => seq.source[key + seq.start-index] := value;
end case;
end method element-setter;
+
define method subsequence(seq :: <string>,
#key start: first = 0,
end: last) => (result :: <string-subsequence>);
- let seq-size = size(seq);
- let subseq-last = if (last) min(last, seq-size) else seq-size end;
+ let subseq-last = if (last) last else max(first, seq.size) end;
if (instance?(seq, <vector>))
make(<vs-subsequence>, source: seq, start: first, end: subseq-last);
@@ -317,3 +380,4 @@
make(<string-subsequence>, source: seq, start: first, end: subseq-last);
end if;
end method subsequence;
+
Modified: trunk/src/common/collection-extensions/vecsearch.dylan
==============================================================================
--- trunk/src/common/collection-extensions/vecsearch.dylan (original)
+++ trunk/src/common/collection-extensions/vecsearch.dylan Thu Jan 25 15:50:31 2007
@@ -34,7 +34,7 @@
//======================================================================
//======================================================================
-// The "string-search" module provides basic search and replace capabilities
+// The "vector-search" module provides basic search and replace capabilities
// upon restricted subsets of <sequence> -- primarily <vector>.
// Exploiting the known properties of these types yields
// substantially better performance than can be achieved for sequences in
@@ -56,7 +56,7 @@
// Find the index of first element (after "from") of a vector which
// satisfies the given predicate. (Like find-key, but accepts start: and end:
// rather than skip:.)
-define method find-first-key(seq :: <vector>, pred?,
+define method find-first-key(seq :: <vector>, pred? :: <function>,
#key start = 0, end: last, failure: fail)
block (return)
let sz = size(seq);
@@ -69,7 +69,7 @@
end method find-first-key;
// Like find-first-key, but goes backward from the end (or from before end:).
-define method find-last-key(seq :: <vector>, pred?,
+define method find-last-key(seq :: <vector>, pred? :: <function>,
#key start = 0, end: last, failure: fail)
block (return)
let sz = size(seq);
@@ -80,3 +80,4 @@
end for
end block
end method find-last-key;
+
Modified: trunk/src/common/regular-expressions/Makegen
==============================================================================
--- trunk/src/common/regular-expressions/Makegen (original)
+++ trunk/src/common/regular-expressions/Makegen Thu Jan 25 15:50:31 2007
@@ -3,8 +3,11 @@
$D2CFLAGS # added by update-libdirs
= $d2c_runtime
. ' -L../collection-extensions'
+ . ' -L../common-dylan'
. ' -L../string-ext'
- . ' -L../table-ext';
+ . ' -L../table-ext'
+ . ' -L../../d2c/runtime/random'
+ . ' -L../../d2c/runtime/threads';
do emit_library_rule(
'RegExp', '$(BUILDROOT)/force.timestamp', '', 'compile',
Modified: trunk/src/common/string-ext/Makegen
==============================================================================
--- trunk/src/common/string-ext/Makegen (original)
+++ trunk/src/common/string-ext/Makegen Thu Jan 25 15:50:31 2007
@@ -3,7 +3,10 @@
$D2CFLAGS # added by update-libdirs
= $d2c_runtime
. ' -L../collection-extensions'
- . ' -L../table-ext';
+ . ' -L../common-dylan'
+ . ' -L../table-ext'
+ . ' -L../../d2c/runtime/random'
+ . ' -L../../d2c/runtime/threads';
do emit_library_rule(
'StringExt', '$(BUILDROOT)/force.timestamp', '', 'compile',
Modified: trunk/src/d2c/compiler/main/Makegen
==============================================================================
--- trunk/src/d2c/compiler/main/Makegen (original)
+++ trunk/src/d2c/compiler/main/Makegen Thu Jan 25 15:50:31 2007
@@ -43,7 +43,6 @@
. ' -L../../../common/string-ext'
. ' -L../../../common/system'
. ' -L../../../common/table-ext'
- . ' -L../../debugger'
. ' -L../base'
. ' -L../cback'
. ' -L../convert'
@@ -51,6 +50,7 @@
. ' -L../front'
. ' -L../optimize'
. ' -L../parser'
+ . ' -L../../debugger'
. ' -L../../runtime/random'
. ' -L../../runtime/threads';
Modified: trunk/src/d2c/dig/Makegen
==============================================================================
--- trunk/src/d2c/dig/Makegen (original)
+++ trunk/src/d2c/dig/Makegen Thu Jan 25 15:50:31 2007
@@ -1,9 +1,12 @@
$D2CFLAGS # added by update-libdirs
= $d2c_runtime
. ' -L../../common/collection-extensions'
+ . ' -L../../common/common-dylan'
. ' -L../../common/regular-expressions'
. ' -L../../common/string-ext'
- . ' -L../../common/table-ext';
+ . ' -L../../common/table-ext'
+ . ' -L../runtime/random'
+ . ' -L../runtime/threads';
$CPPFLAGS = $CPPFLAGS . ' -I$(SRCDIR)';
# We're not going to worry about whether dig is actually *useful* on
Modified: trunk/src/tests/Makegen
==============================================================================
--- trunk/src/tests/Makegen (original)
+++ trunk/src/tests/Makegen Thu Jan 25 15:50:31 2007
@@ -9,9 +9,7 @@
. ' -L../common/matrix'
. ' -L../common/regular-expressions'
. ' -L../common/string-ext'
- . ' -L../common/system'
. ' -L../common/table-ext'
- . ' -L../common/time'
. ' -L../d2c/runtime/random'
. ' -L../d2c/runtime/threads';
More information about the chatter
mailing list