Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Rename align* to pad*. Add start/end to more functions. ifelse -> xif.

  • Loading branch information...
commit 0c6dc2caf17bc73a758ec56da0b010539fc6c47e 1 parent 6a36f3e
@cgay authored
Showing with 151 additions and 104 deletions.
  1. +3 −3 library.dylan
  2. +130 −84 strings.dylan
  3. +18 −17 tests/strings-test-suite.dylan
View
6 library.dylan
@@ -62,9 +62,9 @@ define module strings
strip-left,
strip-right,
- align-center,
- align-left,
- align-right,
+ pad,
+ pad-left,
+ pad-right,
find-substring,
replace-substrings!,
View
214 strings.dylan
@@ -9,12 +9,13 @@ Module: %strings
define constant <string-or-char> = type-union(<string>, <character>);
-// stolen from uncommon-dylan and renamed to ifelse.
-define macro ifelse
- { ifelse(?test:expression, ?true:expression, ?false:expression) }
+// eXpression IF. (Not that the built-in IF isn't an expression.)
+define macro xif
+ { xif(?test:expression, ?true:expression, ?false:expression) }
=> { if (?test) ?true else ?false end }
- { ifelse(?test:expression, ?true:expression) }
- => { if (?test) ?true end }
+
+ { xif(?test:expression, ?true:expression) }
+ => { if (?test) ?true end }
end;
@@ -378,7 +379,7 @@ define method lowercase!
#key start :: <integer> = 0, end: epos :: false-or(<integer>))
=> (string :: <string>)
let epos :: <integer> = epos | string.size;
- range-check(string, size(string), start, epos);
+ range-check(string, string.size, start, epos);
for (i from start below epos)
string[i] := lowercase(string[i])
end;
@@ -418,7 +419,7 @@ define method uppercase!
#key start :: <integer> = 0, end: epos :: false-or(<integer>))
=> (string :: <string>)
let epos :: <integer> = epos | string.size;
- range-check(string, size(string), start, epos);
+ range-check(string, string.size, start, epos);
for (i from start below epos)
string[i] := uppercase(string[i])
end;
@@ -426,136 +427,168 @@ define method uppercase!
end method uppercase!;
-define sealed generic align-right
- (string :: <string>, width :: <integer>, #key fill)
- => (new-string :: <string>);
+define sealed generic pad
+ (string :: <string>, width :: <integer>, #key fill, start, end: epos)
+ => (new-string :: <string>);
-define method align-right
- (string :: <string>, width :: <integer>, #key fill :: <character> = ' ')
+define method pad
+ (string :: <string>, width :: <integer>,
+ #key fill :: <character> = ' ',
+ start :: <integer> = 0,
+ end: epos :: false-or(<integer>))
=> (new-string :: <string>)
// Always return a new string, even if no padding is done.
let slen = string.size;
let nlen = max(width, slen);
- let spos = width - slen; // start of "string" in "new"
+ let spos = floor/(width - slen, 2); // start of "string" in "new"
let new = make(<string>, size: nlen);
- for (ni :: <integer> from 0 below spos)
- new[ni] := fill;
+ for (i :: <integer> from 0 below spos)
+ new[i] := fill;
end;
for (si :: <integer> from 0 below slen,
- ni :: <integer> from spos below nlen)
+ ni :: <integer> from spos below spos + slen)
new[ni] := string[si];
end;
+ for (i :: <integer> from spos + slen below nlen)
+ new[i] := fill;
+ end;
new
-end method align-right;
+end method pad;
-define sealed generic align-left
- (string :: <string>, width :: <integer>, #key fill)
+define sealed generic pad-right
+ (string :: <string>, width :: <integer>, #key fill, start, end: epos)
=> (new-string :: <string>);
-define method align-left
- (string :: <string>, width :: <integer>, #key fill :: <character> = ' ')
+define method pad-right
+ (string :: <string>, width :: <integer>,
+ #key fill :: <character> = ' ',
+ start :: <integer> = 0,
+ end: epos :: false-or(<integer>))
=> (new-string :: <string>)
// Always return a new string, even if no padding is done.
let slen = string.size;
let nlen = max(width, slen);
+ let spos = width - slen; // start of "string" in "new"
let new = make(<string>, size: nlen);
- for (i :: <integer> from 0 below slen)
- new[i] := string[i];
+ for (ni :: <integer> from 0 below spos)
+ new[ni] := fill;
end;
- for (i :: <integer> from slen below nlen)
- new[i] := fill;
+ for (si :: <integer> from 0 below slen,
+ ni :: <integer> from spos below nlen)
+ new[ni] := string[si];
end;
new
-end method align-left;
+end method pad-right;
-define sealed generic align-center
- (string :: <string>, width :: <integer>, #key fill)
- => (new-string :: <string>);
+define sealed generic pad-left
+ (string :: <string>, width :: <integer>, #key fill, start, end: epos)
+ => (new-string :: <string>);
-define method align-center
- (string :: <string>, width :: <integer>, #key fill :: <character> = ' ')
+define method pad-left
+ (string :: <string>, width :: <integer>,
+ #key fill :: <character> = ' ',
+ start :: <integer> = 0,
+ end: epos :: false-or(<integer>))
=> (new-string :: <string>)
// Always return a new string, even if no padding is done.
let slen = string.size;
let nlen = max(width, slen);
- let spos = floor/(width - slen, 2); // start of "string" in "new"
let new = make(<string>, size: nlen);
- for (i :: <integer> from 0 below spos)
- new[i] := fill;
- end;
- for (si :: <integer> from 0 below slen,
- ni :: <integer> from spos below spos + slen)
- new[ni] := string[si];
+ for (i :: <integer> from 0 below slen)
+ new[i] := string[i];
end;
- for (i :: <integer> from spos + slen below nlen)
+ for (i :: <integer> from slen below nlen)
new[i] := fill;
end;
new
-end method align-center;
+end method pad-left;
define sealed generic strip
- (string :: <string>, #key test) => (new-string :: <string>);
+ (string :: <string>, #key test, start, end: epos) => (new-string :: <string>);
define method strip
- (string :: <string>, #key test :: <function> = whitespace?)
+ (string :: <string>,
+ #key test :: <function> = whitespace?,
+ start :: <integer> = 0,
+ end: epos :: false-or(<integer>))
=> (new-string :: <string>)
let untest = complement(test);
- let left = find-key(string, untest);
+ let epos :: <integer> = epos | string.size;
+ let left = %find-key(string, untest, start, epos);
if (~ left)
- strip-right(string, test: test)
+ strip-right(string, test: test, start: start, end: epos)
else
- let right = %find-key-from-end(string, untest) | string.size;
+ let right = %find-key-from-end(string, untest, start, epos) | epos;
copy-sequence(string, start: left, end: right)
end if
end method strip;
define sealed generic strip-left
- (string :: <string>, #key test) => (new-string :: <string>);
+ (string :: <string>, #key test, start, end: epos) => (new-string :: <string>);
define method strip-left
- (string :: <string>, #key test :: <function> = whitespace?)
+ (string :: <string>,
+ #key test :: <function> = whitespace?,
+ start :: <integer> = 0,
+ end: epos :: false-or(<integer>))
=> (new-string :: <string>)
+ let epos :: <integer> = epos | string.size;
copy-sequence(string,
- start: find-key(string, complement(test)) | string.size)
+ start: %find-key(string, complement(test), start, epos) | epos,
+ end: epos)
end;
define sealed generic strip-right
- (string :: <string>, #key test) => (new-string :: <string>);
+ (string :: <string>, #key test, start, end: epos) => (new-string :: <string>);
define method strip-right
- (string :: <string>, #key test :: <function> = whitespace?)
+ (string :: <string>,
+ #key test :: <function> = whitespace?,
+ start :: <integer> = 0,
+ end: epos :: false-or(<integer>))
=> (new-string :: <string>)
- copy-sequence(string, end: %find-key-from-end(string, complement(test))
- | string.size)
+ let epos :: <integer> = epos | string.size;
+ copy-sequence(string,
+ start: start,
+ end: %find-key-from-end(string, complement(test), start, epos)
+ | string.size)
end;
define sealed generic starts-with?
- (string :: <string>, pattern :: <string>, #key ignore-case?)
+ (string :: <string>, pattern :: <string>, #key ignore-case?, start, end: epos)
=> (starts-with? :: <boolean>);
define method starts-with?
- (string :: <string>, pattern :: <string>, #key ignore-case?)
+ (string :: <string>, pattern :: <string>,
+ #key ignore-case?,
+ start :: <integer> = 0,
+ end: epos :: false-or(<integer>))
=> (starts-with? :: <boolean>)
let plen :: <integer> = pattern.size;
- if (plen <= string.size)
- %string-compare(string, pattern, 0, plen, 0, plen, ignore-case?) = 0
+ let epos :: <integer> = epos | string.size;
+ if (plen <= epos - start)
+ %string-compare(string, pattern, start, start + plen, 0, plen, ignore-case?) = 0
end
end method starts-with?;
define sealed generic ends-with?
- (string :: <string>, pattern :: <string>, #key ignore-case?)
+ (string :: <string>, pattern :: <string>, #key ignore-case?, start, end: epos)
=> (ends-with? :: <boolean>);
define method ends-with?
- (string :: <string>, pattern :: <string>, #key ignore-case?)
+ (string :: <string>, pattern :: <string>,
+ #key ignore-case?,
+ start :: <integer> = 0,
+ end: epos :: false-or(<integer>))
=> (ends-with? :: <boolean>)
let slen :: <integer> = string.size;
let plen :: <integer> = pattern.size;
- if (plen <= slen)
- %string-compare(string, pattern, slen - plen, slen, 0, plen, ignore-case?) = 0
+ let epos :: <integer> = epos | string.size;
+ if (plen <= epos - start)
+ %string-compare(string, pattern, epos - plen, epos, 0, plen, ignore-case?) = 0
end
end method ends-with?;
@@ -608,9 +641,9 @@ define sealed method split-lines
let part = copy-sequence(string, start: bpos, end: sep-start | epos);
case
~sep-start =>
- ifelse(remove-if-empty? & empty?(part),
- parts,
- pair(part, parts));
+ xif(remove-if-empty? & empty?(part),
+ parts,
+ pair(part, parts));
sep-end = epos => // trailing EOL
pair(part, parts);
remove-if-empty? & empty?(part) =>
@@ -641,22 +674,22 @@ define inline function %string-compare
start2 :: <integer>, end2 :: <integer>,
ignore-case? :: <boolean>)
=> (result :: one-of(-1, 0, 1))
- range-check(string1, size(string1), start1, end1);
- range-check(string2, size(string2), start2, end2);
- let eq? :: <function> = ifelse(ignore-case?,
- method (c1 :: <character>, c2 :: <character>)
- as-lowercase(c1) == as-lowercase(c2)
- end,
- \==);
- let less? :: <function> = ifelse(ignore-case?,
- method (c1 :: <character>, c2 :: <character>)
- as-lowercase(c1) < as-lowercase(c2)
- end,
- \<);
+ range-check(string1, string1.size, start1, end1);
+ range-check(string2, string2.size, start2, end2);
+ let eq? :: <function> = xif(ignore-case?,
+ method (c1 :: <character>, c2 :: <character>)
+ as-lowercase(c1) == as-lowercase(c2)
+ end,
+ \==);
+ let less? :: <function> = xif(ignore-case?,
+ method (c1 :: <character>, c2 :: <character>)
+ as-lowercase(c1) < as-lowercase(c2)
+ end,
+ \<);
iterate loop (i1 :: <integer> = start1, i2 :: <integer> = start2)
case
i1 = end1 =>
- ifelse(i2 = end2, 0, -1);
+ xif(i2 = end2, 0, -1);
i2 = end2 =>
1;
otherwise =>
@@ -684,14 +717,27 @@ end;
define inline function %find-key-from-end
- (string :: <string>, test :: <function>) => (key :: false-or(<integer>))
- iterate loop (i = string.size - 1)
- if (i >= 0)
- if (test(string[i]))
- i + 1
- else
- loop(i - 1)
- end
+ (string :: <string>, test :: <function>, start :: <integer>, epos :: <integer>)
+ => (key :: false-or(<integer>))
+ iterate loop (i = epos - 1)
+ if (i >= start)
+ xif (test(string[i]),
+ i + 1,
+ loop(i - 1))
end
end iterate
end function %find-key-from-end;
+
+
+// Like find-key but accepts start/end args. Would like to add them to find-key.
+define function %find-key
+ (seq :: <sequence>, test :: <function>, start :: <integer>, epos :: <integer>)
+ => (key :: false-or(<integer>))
+ iterate loop (i = start)
+ if (i < epos)
+ xif(test(seq[i]),
+ i,
+ loop(i + 1))
+ end
+ end
+end function %find-key;
View
35 tests/strings-test-suite.dylan
@@ -37,6 +37,7 @@ define module-spec strings ()
open generic-function char-equal-ic? (<character>, <character>) => (<boolean>);
open generic-function char-greater-ic? (<character>, <character>) => (<boolean>);
open generic-function char-less-ic? (<character>, <character>) => (<boolean>);
+
open generic-function string-compare (<string>, <string>, #"key", #"start1", #"end1", #"start2", #"end2", #"ignore-case?") => (one-of(-1, 0, 1));
open generic-function string-equal? (<string>, <string>, #"key", #"start1", #"end1", #"start2", #"end2") => (<boolean>);
open generic-function string-greater? (<string>, <string>, #"key", #"start1", #"end1", #"start2", #"end2") => (<boolean>);
@@ -47,18 +48,18 @@ define module-spec strings ()
open generic-function starts-with? (<string>, <string>, #"key", #"ignore-case?") => (<boolean>);
open generic-function ends-with? (<string>, <string>, #"key", #"ignore-case?") => (<boolean>);
- open generic-function lowercase (<string-or-char>) => (<string-or-char>);
- open generic-function lowercase! (<string-or-char>) => (<string-or-char>);
- open generic-function uppercase (<string-or-char>) => (<string-or-char>);
- open generic-function uppercase! (<string-or-char>) => (<string-or-char>);
+ open generic-function lowercase (<string-or-char>, #"key") => (<string-or-char>);
+ open generic-function lowercase! (<string-or-char>, #"key") => (<string-or-char>);
+ open generic-function uppercase (<string-or-char>, #"key") => (<string-or-char>);
+ open generic-function uppercase! (<string-or-char>, #"key") => (<string-or-char>);
- open generic-function strip (<string>, #"key", #"test") => (<string>);
- open generic-function strip-left (<string>, #"key", #"test") => (<string>);
- open generic-function strip-right (<string>, #"key", #"test") => (<string>);
+ open generic-function strip (<string>, #"key", #"test", #"start", #"end") => (<string>);
+ open generic-function strip-left (<string>, #"key", #"test", #"start", #"end") => (<string>);
+ open generic-function strip-right (<string>, #"key", #"test", #"start", #"end") => (<string>);
- open generic-function align-center (<string>, <integer>, #"key", #"fill") => (<string>);
- open generic-function align-left (<string>, <integer>, #"key", #"fill") => (<string>);
- open generic-function align-right (<string>, <integer>, #"key", #"fill") => (<string>);
+ open generic-function pad (<string>, <integer>, #"key", #"fill", #"start", #"end") => (<string>);
+ open generic-function pad-left (<string>, <integer>, #"key", #"fill", #"start", #"end") => (<string>);
+ open generic-function pad-right (<string>, <integer>, #"key", #"fill", #"start", #"end") => (<string>);
open generic-function find-substring (<string>, <string>, #"key", #"start", #"end", #"ignore-case?") => (false-or(<integer>));
open generic-function replace-substrings! (<string>, <string>, <string>, #"key", #"start", #"end", #"count", #"ignore-case?") => (<string>);
@@ -267,20 +268,20 @@ end function-test hexadecimal-digit?;
////
-//// Alignments
+//// Padding
////
-define strings function-test align-left ()
+define strings function-test pad-left ()
//---*** Fill this in...
-end function-test align-left;
+end function-test pad-left;
-define strings function-test align-center ()
+define strings function-test pad ()
//---*** Fill this in...
-end function-test align-center;
+end function-test pad;
-define strings function-test align-right ()
+define strings function-test pad-right ()
//---*** Fill this in...
-end function-test align-right;
+end function-test pad-right;
////
Please sign in to comment.
Something went wrong with that request. Please try again.