[commit] r2314 - forth/lib

[repository service]

Author: wmb
Date: Mon Jun 27 22:49:20 2011
New Revision: 2314
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2314

Log:
Added $compare and $caps-compare for lexicographic string comparision considering both string contents and length.

Modified:
   forth/lib/stringop.fth

Modified: forth/lib/stringop.fth
==============================================================================
--- forth/lib/stringop.fth	Mon Jun 27 18:54:07 2011	(r2313)
+++ forth/lib/stringop.fth	Mon Jun 27 22:49:20 2011	(r2314)
@@ -108,6 +108,59 @@
    until then then                ( adr )
    here over -
 ;
+\ The result is < = > zero when $1 is < = > $2
+: $compare  ( $1 $2 -- -1|0|1 )
+   rot                               ( adr1 adr2 len2 len1 )
+   2dup =  if                        ( adr1 adr2 len2 len1 )
+      \ The strings are the same length, so consider only their contents
+      drop comp                 ( -1|0|1 )
+   else                              ( adr1 adr2 len2 len1 )
+      \ The lengths differ, so consider both contents and length
+      \ First consider the contents within the length of the shorter string
+      2>r  2r@ min                   ( adr1 adr2 min-len r: len2 len1 )
+      comp  ?dup  if            ( -1|1 r: len2 len1 )
+         \ The initial substrings differ, determining the answer
+	 2r> 2drop                   ( -1|1 )
+      else                           ( r: len2 len1 )
+         \ The initial substring are the same, so the longer string is ">"
+         2r>  swap                   ( len1 len2 )
+	 <  if  -1  else  1  then    ( -1|1 )
+      then
+   then
+;
+\ The result is < = > zero when $1 is < = > $2
+: $caps-compare  ( $1 $2 -- -1|0|1 )
+   rot                               ( adr1 adr2 len2 len1 )
+   2dup =  if                        ( adr1 adr2 len2 len1 )
+      \ The strings are the same length, so consider only their contents
+      drop caps-comp                 ( -1|0|1 )
+   else                              ( adr1 adr2 len2 len1 )
+      \ The lengths differ, so consider both contents and length
+      \ First consider the contents within the length of the shorter string
+      2>r  2r@ min                   ( adr1 adr2 min-len r: len2 len1 )
+      caps-comp  ?dup  if            ( -1|1 r: len2 len1 )
+         \ The initial substrings differ, determining the answer
+	 2r> 2drop                   ( -1|1 )
+      else                           ( r: len2 len1 )
+         \ The initial substring are the same, so the longer string is ">"
+         2r>  swap                   ( len1 len2 )
+	 <  if  -1  else  1  then    ( -1|1 )
+      then
+   then
+;
+0 [if] \ Test cases
+" "   " "     $compare .
+" a"  " a"    $compare .
+" a"  " b"    $compare .
+" a"  " ab"   $compare .
+" b"  " a"    $compare .
+" b"  " ab"   $compare .
+" a"  " a"    $caps-compare .
+" a"  " B"    $caps-compare .
+" a"  " Ba"   $caps-compare .
+" B"  " a"    $caps-compare .
+" B"  " ab"   $caps-compare .
+[then]

\ LICENSE_BEGIN
 \ Copyright (c) 2006 FirmWorks