[Gd-chatter] r10899 - trunk/ltd/lib
housel at gwydiondylan.org
housel at gwydiondylan.org
Tue Sep 5 03:46:37 CEST 2006
Author: housel
Date: Tue Sep 5 03:46:34 2006
New Revision: 10899
Removed:
trunk/ltd/lib/cl-strings.dylan
Modified:
trunk/ltd/lib/cl-plists.dylan
trunk/ltd/lib/cl-sequences.dylan
trunk/ltd/lib/cl.lid
trunk/ltd/lib/macros.dylan
trunk/ltd/lib/module.dylan
Log:
Bug: 7322
- Fix several syntax errors
- Obtain cl-strings bindings from the duim-utilities library
- Obtain (most) cl-plists bindings from the collections library
Modified: trunk/ltd/lib/cl-plists.dylan
==============================================================================
--- trunk/ltd/lib/cl-plists.dylan (original)
+++ trunk/ltd/lib/cl-plists.dylan Tue Sep 5 03:46:34 2006
@@ -2,250 +2,26 @@
Author: Scott McKay, Peter Norvig
Copyright: 1995 by Harlequin, Inc.
-define generic get-property (plist :: <sequence>, indicator, #key default)
- => property :: <object>;
-
-define method get-property (plist :: <list>, indicator, #key default)
- block (return)
- while (#t)
- when (empty?(plist))
- return(default)
- end;
- when (pop!(plist) == indicator)
- return(head(plist))
- end;
- plist := tail(plist)
- end
- end
-end method get-property;
-
-define method get-property (plist :: <vector>, indicator, #key default)
- block (return)
- for (i from 0 below size(plist) by 2)
- when (plist[i] == indicator)
- return(plist[i + 1])
- end;
- finally
- return(default);
- end
- end
-end method get-property;
-
-
-// Modifies PLIST
-define generic do-put-property! (plist :: <sequence>, indicator, value)
- => plist :: <sequence>;
-
-define method do-put-property!
- (plist :: <list>, indicator, value) => plist :: <list>;
- block (return)
- let pl = plist;
- while (#t)
- when (empty?(pl))
- return(concatenate!(plist, list(indicator, value)))
- end;
- when (pop!(pl) == indicator & pl)
- head(pl) := value;
- return(plist)
- end;
- pl := tail(pl)
- end
- end
-end method do-put-property!;
-
-define method do-put-property!
- (plist :: <vector>, indicator, value) => plist :: <vector>;
- block (return)
- for (i from 0 below size(plist) by 2)
- when (plist[i] == indicator)
- plist[i + 1] := value;
- return(plist)
- end;
- finally
- return(concatenate!(plist, vector(indicator, value)));
- end
- end
-end method do-put-property!;
-
-define macro put-property!
- { put-property! (?plist, ?indicator, ?value) }
- => { ?plist := do-put-property!(?plist, ?indicator, ?value); }
-end macro;
-
-
-// Modifies PLIST
-define generic do-remove-property! (plist :: <sequence>, indicator)
- => plist :: <sequence>;
-
-define method do-remove-property!
- (plist :: <list>, indicator) => plist :: <list>;
- block (return)
- let result-plist = plist;
- let pl = plist;
- let ppl = #f;
- while (#t)
- when (empty?(pl))
- return(#f, result-plist)
- end;
- when (first(pl) == indicator)
- let result = second(pl);
- if (pl == plist)
- result-plist := tail(tail(result-plist))
- else
- tail(ppl) := tail(tail(pl))
- end;
- return(result, result-plist)
- end;
- if (pl == plist)
- ppl := tail(pl)
- else
- ppl := tail(tail(ppl))
- end;
- pl := tail(tail(pl))
- end
- end
-end method do-remove-property!;
-
-define method do-remove-property!
- (plist :: <vector>, indicator) => plist :: <vector>;
- let j = 0;
- let value = #f;
- for (i from 0 below size(plist) by 2)
- unless (plist[i] == indicator)
- plist[j] := plist[i];
- plist[j + 1] := plist[i + 1];
- value := plist[i + 1];
- j := j + 2;
- end;
- end;
- size(plist) := j;
- values(value, plist)
-end method do-remove-property!;
-
-define macro remove-property!
- { remove-property! (?plist, ?indicator) }
- => { begin
- let (_value, _new-plist) = do-remove-property!(?plist, ?indicator);
- ?plist := _new-plist;
- _value;
- end; }
-end macro;
-
-
-define generic remove-keywords (plist :: <sequence>, keywords :: <sequence>)
- => plist :: <sequence>;
-
-define method remove-keywords
- (plist :: <list>, keywords :: <sequence>) => plist :: <vector>;
- case
- empty?(plist) =>
- plist;
- empty?(keywords) =>
- plist;
- otherwise =>
- let new-plist = make(<stretchy-vector>, size: size(plist));
- let j = 0;
- if (size(keywords) = 1) // speed bum when only one keyword
- let keyword = first(keywords);
- block (return)
- while (#t)
- begin
- let indicator = pop!(plist);
- let value = pop!(plist);
- unless (keyword == indicator)
- new-plist[j] := indicator;
- new-plist[j + 1] := value;
- j := j + 2;
- end
- end;
- when (empty?(plist))
- return()
- end
- end
- end
- else
- block (return)
- while (#t)
- begin
- let indicator = pop!(plist);
- let value = pop!(plist);
- unless (cl-find(keywords, indicator))
- new-plist[j] := indicator;
- new-plist[j + 1] := value;
- j := j + 2;
- end
- end;
- when (empty?(plist))
- return()
- end
- end
- end
- end;
- size(new-plist) := j;
- new-plist
- end
-end method remove-keywords;
-
-define method remove-keywords
- (plist :: <vector>, keywords :: <sequence>) => plist :: <vector>;
- case
- empty?(plist) =>
- plist;
- empty?(keywords) =>
- plist;
- otherwise =>
- let length = size(plist);
- let new-plist = make(<stretchy-vector>, size: length);
- let j = 0;
- if (size(keywords) = 1) // speed bum when only one keyword
- let keyword = first(keywords);
- for (i from 0 below length by 2)
- let indicator = plist[i];
- let value = plist[i + 1];
- unless (keyword == indicator)
- new-plist[j] := indicator;
- new-plist[j + 1] := value;
- j := j + 2;
- end;
- end
- else
- for (i from 0 below length by 2)
- let indicator = plist[i];
- let value = plist[i + 1];
- unless (cl-find(keywords, indicator))
- new-plist[j] := indicator;
- new-plist[j + 1] := value;
- j := j + 2;
- end;
- end
- end;
- size(new-plist) := j;
- new-plist
- end
-end method remove-keywords;
-
-define macro with-keywords-removed
- { with-keywords-removed (?new-plist = (?plist, ?keywords)) ?body end}
- => { begin
- let ?new-plist = remove-keywords(?plist, ?keywords);
- ?body
- end; }
-end macro;
-
// Following additions by Peter Norvig:
-defne constant $symbol-plists = make(<table>);
+define constant $symbol-plists :: <object-table> = make(<object-table>);
-define method symbol-plist (symbol) $symbol-plist[symbol] end;
+define method symbol-plist (symbol)
+ $symbol-plists[symbol]
+end;
+
+define method symbol-plist-setter (value, symbol)
+ $symbol-plists[symbol] := value;
+end;
-define method symbol-get-property (symbol indicator)
+define method symbol-get-property (symbol, indicator)
get-property(symbol-plist(symbol), indicator)
end;
-define method symbol-get-property-setter (value symbol indicator)
+define method symbol-get-property-setter (value, symbol, indicator)
put-property!(symbol-plist(symbol), indicator, value)
end;
-define method symbol-remove-property (symbol indicator)
+define method symbol-remove-property (symbol, indicator)
remove-property!(symbol-plist(symbol), indicator)
end;
Modified: trunk/ltd/lib/cl-sequences.dylan
==============================================================================
--- trunk/ltd/lib/cl-sequences.dylan (original)
+++ trunk/ltd/lib/cl-sequences.dylan Tue Sep 5 03:46:34 2006
@@ -189,7 +189,7 @@
let telt = sequence[i];
when (telt)
// skip null items
- let tkey = if (key) key(car(telt)) else head(telt) end;
+ let tkey = if (key) key(head(telt)) else head(telt) end;
when (predicate(tkey))
return(telt)
end
@@ -551,27 +551,33 @@
index >= finish
| if (from-end?)
//never duplicated
- for (tindex from start below result-index)
- let elt = sequence[tindex];
- let tkey = if (key) key(elt) else elt end;
- when (test(tkey, test-key))
- // TEST-ELEMENT is an earlier duplicate of element
- when (replace?)
- sequence[tindex] := test-element
+ block (return)
+ for (tindex from start below result-index)
+ let elt = sequence[tindex];
+ let tkey = if (key) key(elt) else elt end;
+ when (test(tkey, test-key))
+ // TEST-ELEMENT is an earlier duplicate of element
+ when (replace?)
+ sequence[tindex] := test-element
+ end;
+ return(#f)
end;
- return(#f)
- end;
- finally return(#t);
- end
+ finally
+ #t;
+ end
+ end block
else
- for (tindex from index + 1 below finish)
- let elt = sequence[tindex];
- let tkey = if (key) key(elt) else elt end;
- when (test(test-key, tkey))
- return(#f)
- end;
- finally return(#t);
- end
+ block (return)
+ for (tindex from index + 1 below finish)
+ let elt = sequence[tindex];
+ let tkey = if (key) key(elt) else elt end;
+ when (test(test-key, tkey))
+ return(#f)
+ end;
+ finally
+ #t;
+ end
+ end block
end =>
// Not a duplicate
sequence[result-index] := test-element;
@@ -1360,14 +1366,15 @@
// Following additions by Peter Norvig
define method cl-reduce-compares (op :: <function>)
- method (args :: <list>))
+ method (args :: <list>)
block (return)
while (~ empty?(tail(args)))
if (~ op(first(args),second(args)))
return(#f)
else
args := tail(args)
- end
- end
- end
+ end if
+ end while
+ end block
+ end method
end method cl-reduce-compares;
Modified: trunk/ltd/lib/cl.lid
==============================================================================
--- trunk/ltd/lib/cl.lid (original)
+++ trunk/ltd/lib/cl.lid Tue Sep 5 03:46:34 2006
@@ -7,4 +7,3 @@
macros
cl-sequences
cl-plists
- cl-strings
Modified: trunk/ltd/lib/macros.dylan
==============================================================================
--- trunk/ltd/lib/macros.dylan (original)
+++ trunk/ltd/lib/macros.dylan Tue Sep 5 03:46:34 2006
@@ -4,21 +4,15 @@
// 'push!' and 'pop!' are intended to be called only on lists
define macro push!
- { push! (?list, ?item) }
+ { push! (?list:name, ?item:expression) }
=> { ?list := add!(?list, ?item) }
end;
define macro pop!
- { pop! (?list) }
+ { pop! (?list:name) }
=> { begin
let _result = head(?list);
?list := tail(?list);
_result
end }
end;
-
-
-define macro false-or
- { false-or (?type) }
- => { union(?type, singleton(#f)) }
-end;
Modified: trunk/ltd/lib/module.dylan
==============================================================================
--- trunk/ltd/lib/module.dylan (original)
+++ trunk/ltd/lib/module.dylan Tue Sep 5 03:46:34 2006
@@ -2,8 +2,9 @@
Author: Scott McKay
define library CL
- use dylan;
- use harlequin-extensions;
+ use common-dylan;
+ use collections;
+ use duim-utilities;
export
CL-macros,
CL-sequences,
@@ -13,8 +14,7 @@
define module CL-macros
use dylan;
- create \push!, \pop!,
- \false-or;
+ create \push!, \pop!;
end;
define module CL-sequences
@@ -24,9 +24,9 @@
cl-assoc, cl-assoc-if,
cl-count, cl-count-if,
cl-remove, cl-remove-if,
- cl-remove!, cl-remove!-if,
+ cl-remove!, cl-remove-if!,
cl-substitute, cl-substitute-if,
- cl-substitute!, cl-substitute!-if,
+ cl-substitute!, cl-substitute-if!,
cl-remove-duplicates, cl-remove-duplicates!,
cl-search,
cl-mismatch,
@@ -35,39 +35,35 @@
define module CL-plists
use dylan;
- create get-property,
- \put-property!,
- \remove-property!,
- remove-keywords,
- \with-keywords-removed;
+ use plists, export: all;
end;
define module CL-strings
use dylan;
- create char-equal?, char-not-equal?,
- char-less?, char-not-less?,
- char-greater?, char-not-greater?,
- string-equal?, string-not-equal?,
- string-less?, string-not-less?,
- string-greater?, string-not-greater?,
- alpha-char?, digit-char?,
- alphanumeric-char?,
- upper-case?, lower-case?,
- standard-char?,
- graphic-char?,
- ordinary-char?,
- whitespace-char?,
- string-capitalize, string-capitalize!,
- string-capitalize-words, string-capitalize-words!,
- string-trim, string-left-trim, string-right-trim,
- string-search-set, string-search-not-set,
- string-pluralize,
- string-a-or-an;
+ use duim-utilities,
+ export: { char-equal?, char-not-equal?,
+ char-less?, char-not-less?,
+ char-greater?, char-not-greater?,
+ string-equal?, string-not-equal?,
+ string-less?, string-not-less?,
+ string-greater?, string-not-greater?,
+ alpha-char?, digit-char?,
+ alphanumeric-char?,
+ upper-case?, lower-case?,
+ standard-char?,
+ graphic-char?,
+ ordinary-char?,
+ whitespace-char?,
+ string-capitalize, string-capitalize!,
+ string-capitalize-words, string-capitalize-words!,
+ string-trim, string-left-trim, string-right-trim,
+ string-search-set, string-search-not-set,
+ string-pluralize,
+ string-a-or-an };
end;
define module CL-internals
- use dylan;
- use harlequin-extensions;
+ use common-dylan;
use CL-macros;
use CL-sequences;
use CL-plists;
More information about the chatter
mailing list