Skip to content

Commit

Permalink
Improved behavior of "string is double", but still having problems wi…
Browse files Browse the repository at this point in the history 
…th signs. Need a parser rule, I think.

Added string_map, with the test cases take from the manual.

Signed-off-by: Austin Hastings <Austin_Hastings@Yahoo.com>
  • Loading branch information
Austin Hastings authored and Austin Hastings committed Mar 27, 2010
1 parent 28674d6 commit 1160287
Show file tree
Hide file tree
Showing 2 changed files with 95 additions and 23 deletions.
115 changes: 92 additions & 23 deletions src/Partcl/commands/string.pm
View file
Expand Up @@ -78,7 +78,7 @@ INIT {
%String_funcs<is_boolean> := String::is_boolean;
%String_funcs<is_control> := String::is_cclass;
%String_funcs<is_digit> := String::is_cclass;
%String_funcs<is_double> := String::is_token;
%String_funcs<is_double> := String::is_double;
%String_funcs<is_false> := String::is_token;
%String_funcs<is_graph> := String::is_cclass;
%String_funcs<is_integer> := String::is_token;
Expand All @@ -100,6 +100,9 @@ INIT {
%Arg_limits<length> := [ 1, 1, "string" ];

%String_funcs<map> := String::map;
%Arg_limits<map> := [ 2, 3, "?-nocase? mapping string" ];
%Command_options<map><-nocase> := 1;
%Command_options<map><ERROR> := '-nocase';

%String_funcs<match> := String::match;
%Arg_limits<match> := [ 2, 3, "?-nocase? pattern string" ];
Expand Down Expand Up @@ -150,30 +153,30 @@ INIT {
%String_token<wideinteger> := 'integer';

}

my sub bytelength($string) {
pir::bytelength__is(~ $string);
}

my sub compare($s1, $s2, *%options) {
my sub compare($s1, $s2, :$length, :$nocase = 0) {

my $length := %options<-length>;

if pir::defined($length) {
unless $length < 0 {
$s1 := pir::substr__SSII($s1, 0, $length);
$s2 := pir::substr__SSII($s2, 0, $length);
}
}

if %options<-nocase> {
if $nocase {
$s1 := pir::upcase__SS($s1);
$s2 := pir::upcase__SS($s2);
}

pir::cmp__IPP($s1, $s2);
}

# Parses optional -args, and generates "wrong#args" errors and "bad option -foo" errors.
# Dispatches to fairly normal NQP subs for the detailed work.
our sub dispatch_command(*@args) {
my $num_args := +@args;

Expand Down Expand Up @@ -203,10 +206,12 @@ our sub dispatch_command(*@args) {
$shift := %opts_allowed{$arg};

if $shift == 2 {
$arg := pir::substr__SSI($arg, 1);
%options{$arg} := @args[1 + $opt_offset];
pir::splice__vPPII(@args, [], $opt_offset, $shift);
}
elsif $shift == 1 {
$arg := pir::substr__SSI($arg, 1);
%options{$arg} := 1;
pir::splice__vPPII(@args, [], $opt_offset, $shift);
}
Expand Down Expand Up @@ -248,11 +253,11 @@ my sub index($string, $charIndex) {
}
}

my sub is($class, $string, *%options) {
my sub is($class, $string, :$failindex, :$strict = 0) {
my $*length := pir::length__IS($string);

if $*length == 0 {
1 - %options<-strict>;
! $strict;
}
else {
my $*failindex := -1;
Expand All @@ -262,23 +267,13 @@ my sub is($class, $string, *%options) {
my $result := &subcommand($string);

unless $result {
# FIXME: Store $*failindex into variable named by %options<-failindex>
# FIXME: Store $*failindex into variable named by $failindex
}

$result;
}
}

my sub is_boolean($string) {
is_token($string, :rule('term:sym<true>')) || is_token($string, :rule('term:sym<false>'));
}

my sub is_cclass($string) {
my $cclass := %CCLASS{%String_cclass{$*class}};
$*failindex := pir::find_not_cclass__IISII($cclass, $string, 0, $*length);
$*failindex >= $*length;
}

my sub is_ascii($string) {
my $index := 0;
my $result := 1;
Expand All @@ -296,6 +291,20 @@ my sub is_ascii($string) {
$result;
}

my sub is_boolean($string) {
is_token($string, :rule('term:sym<true>')) || is_token($string, :rule('term:sym<false>'));
}

my sub is_cclass($string) {
my $cclass := %CCLASS{%String_cclass{$*class}};
$*failindex := pir::find_not_cclass__IISII($cclass, $string, 0, $*length);
$*failindex >= $*length;
}

my sub is_double($string) {
is_token($string, :rule<dec_number>) || is_token($string, :rule<integer>);
}

my sub is_token($string, :$rule = %String_token{$*class}) {
my $compiler := pir::compreg__PS('Partcl');

Expand Down Expand Up @@ -328,13 +337,73 @@ my sub length($string) {
pir::length__IS($string);
}

my sub map(*@args) {
'';
my sub map($mapping, $string, :$nocase = 0) {

error("Bogus charMap - must have an even # of entries")
if pir::elements__IP($mapping) % 2 == 1;

my %first_chars;
my @char_map;
my %char_map;

for $mapping.getList -> $from, $to {

if $nocase {
$from := pir::downcase__SS($from);
%first_chars{my $from0 := $from[0]} := 1;
%first_chars{pir::upcase__SS($from0)} := 1;
%first_chars{pir::titlecase__SS($from0)} := 1;
}
else {
%first_chars{$from[0]} := 1;
}

# Would rather use 'exists' but can't make a key on the fly.
unless pir::defined(%char_map{$from}) {
%char_map{$from} := $to;
@char_map.push: $from;
}
}

my $index := 0;
my $length := pir::length__IS($string);
my $glyph;
my $concat;
my $skip := 1;

my $result := '';

while $index < $length {
$concat := $glyph := $string[$index];
pir::assign__vPI($skip, 1);

if pir::defined(%first_chars{$glyph}) {
my $done := 0; # Really needing 'last' here...

for @char_map -> $key {
my $key_length := pir::length__IS($key);

if ! $done
&& equal($key, pir::substr__SSII($string, $index, $key_length),
:nocase($nocase), :length($key_length)) {

pir::assign__vPP($skip, $key_length);
$concat := %char_map{$key};
$done := 1;
}
}
}

pir::concat__vPP($result, $concat);
pir::add__vPP($index, $skip);
}

$result;
}

my sub match($pattern, $string, *%options) {
my sub match($pattern, $string, :$nocase = 0) {

if %options<-nocase> {
if $nocase {
$pattern := pir::downcase__ss($pattern);
$string := pir::downcase__ss($string);
}
Expand Down
3 changes: 3 additions & 0 deletions t/cmd_string.t
View file
Expand Up @@ -307,6 +307,9 @@ is [string is false false] 1

eval_is {string is double -monkeys uncle} {bad option "-monkeys": must be -strict or -failindex} {bad [string is] option}

is [string map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc] 01321221 {string map example}
is [string map {1 0 ab 2 a 3 abc 1} 1abcaababcabababc] 02c322c222c {string map reordered example}


# these tests rely on ICU
is [string match -nocase ABC abc] 1 {string match nocase}
Expand Down

0 comments on commit 1160287

Please sign in to comment.