Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
move guts of TclString's get_bool vtable into an NQP method.
  • Loading branch information
coke committed Dec 12, 2009
1 parent ce11002 commit aaf6aba
Show file tree
Hide file tree
Showing 2 changed files with 41 additions and 53 deletions.
41 changes: 40 additions & 1 deletion src/TclString.pm
Expand Up @@ -2,7 +2,7 @@

module TclString {

method getInteger () { ## :is vtable
method getInteger() { ## :is vtable

my $parse := Partcl::Grammar.parse(
self,
Expand All @@ -17,6 +17,45 @@ module TclString {
error('expected integer but got "' ~ self ~ '"');
}
}

method getBoolean() { ## :is vtable
my $check := pir::downcase__ss(self);


if $check eq 'true' || $check eq 'tru' || $check eq 'tr' || $check eq 't' {
return 1;
}
if $check eq 'yes' || $check eq 'ye' || $check eq 'y' {
return 1;
}
if $check eq 'on' {
return 1;
}
if $check eq 'false' || $check eq 'fals' || $check eq 'fal' || $check eq 'fa' || $check eq 'f' {
return 0;
}
if $check eq 'no' || $check eq 'n' {
return 0;
}
if $check eq 'off' || $check eq 'of' {
return 0;
}

my $bool := -1;

try {
$bool := ?self.getInteger();
CONTROL {}
};


if $bool != -1 {
return $bool;
} else {
error('expected boolean value but got "' ~ self ~ '"');
}
}

}

# vim: filetype=perl6:
53 changes: 1 addition & 52 deletions src/class/tclstring.pir
Expand Up @@ -28,59 +28,8 @@ A Tcl-style string
.end

.namespace [ 'TclString' ]

=head2 get_bool

Replace default truthiness.

=cut

.sub get_bool :vtable

.local string check
check = self
downcase check, check

eq check, 'true', yes
eq check, 'tru', yes
eq check, 'tr', yes
eq check, 't', yes
eq check, 'yes', yes
eq check, 'ye', yes
eq check, 'y', yes
eq check, 'on', yes

eq check, 'false', no
eq check, 'fals', no
eq check, 'fal', no
eq check, 'fa', no
eq check, 'f', no
eq check, 'no', no
eq check, 'n', no
eq check, 'off', no
eq check, 'of', no

# is this an int? use that value.
$I1 = check
$S1 = $I1
ne check, $S1, mu
eq $I1, 0, no
goto yes

mu:
$S1 = self
$S1 = 'expected boolean value but got "' . $S1
$S1 .= '"'
$P1 = new 'Exception'
.include 'except_types.pasm'
$P1['type'] = .CONTROL_ERROR
$P1['message'] = $S1
throw $P1

no:
.return(0)
yes:
.return(1)
.tailcall self.'getBoolean'()
.end

.sub get_integer :vtable
Expand Down

0 comments on commit aaf6aba

Please sign in to comment.