New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Implementation of StrPos #236
Comments
From @bacekHello. Trivial and initial implementation of StrPos attached. -- |
From @bacekstrpos.diffdiff --git a/languages/perl6/src/builtins/any-str.pir b/languages/perl6/src/builtins/any-str.pir
index 3516a44..ba56169 100644
--- a/languages/perl6/src/builtins/any-str.pir
+++ b/languages/perl6/src/builtins/any-str.pir
@@ -46,6 +46,7 @@ the size of that file down and to emphasize their generic,
.param int pos :optional
.param int has_pos :opt_flag
.local pmc retv
+ .local pmc strposproto
if has_pos goto have_pos
pos = 0
@@ -54,6 +55,8 @@ the size of that file down and to emphasize their generic,
.local string s
s = self
+ strposproto = get_hll_global 'StrPos'
+
check_substring:
if substring goto substring_search
$I0 = length s
@@ -66,12 +69,11 @@ the size of that file down and to emphasize their generic,
if pos < 0 goto fail
done:
- $P0 = new 'Int'
- $P0 = pos
+ $P0 = strposproto.'new'('pos'=>pos)
.return ($P0)
fail:
- $P0 = new 'Failure'
+ $P0 = strposproto.'new'()
.return ($P0)
.end
diff --git a/languages/perl6/src/classes/Str.pir b/languages/perl6/src/classes/Str.pir
index bc36b82..c058c6a 100644
--- a/languages/perl6/src/classes/Str.pir
+++ b/languages/perl6/src/classes/Str.pir
@@ -9,6 +9,8 @@ Str - Perl 6 Str class and related functions
This file sets up the C<Perl6Str> PMC type (from F<src/pmc/perl6str.pmc>)
as the Perl 6 C<Str> class.
+Also implements StrPos type as described in S29.
+
=head1 Methods
=over 4
@@ -20,7 +22,7 @@ as the Perl 6 C<Str> class.
.include 'cclass.pasm'
.sub 'onload' :anon :init :load
- .local pmc p6meta, strproto
+ .local pmc p6meta, strproto, strposproto
p6meta = get_hll_global ['Perl6Object'], '$!P6META'
strproto = p6meta.'new_class'('Str', 'parent'=>'Perl6Str Any')
p6meta.'register'('Perl6Str', 'parent'=>strproto, 'protoobject'=>strproto)
@@ -28,6 +30,8 @@ as the Perl 6 C<Str> class.
$P0 = get_hll_namespace ['Str']
'!EXPORT'('sprintf', 'from'=>$P0)
+
+ strproto = p6meta.'new_class'('StrPos', 'parent'=>'Any', 'attr'=>'$!pos')
.end
@@ -451,10 +455,6 @@ Note: Most users should just let their I/O handles autochomp instead.
This word is banned in Perl 6. You must specify units.
-=item index
-
-Needs to be in terms of StrPos, not Int.
-
=item pack
=item pos
@@ -482,6 +482,77 @@ Should replace vec with declared arrays of bit, uint2, uint4, etc.
=cut
+.namespace ['StrPos']
+
+=over
+
+=item get_bool
+
+=cut
+
+.sub 'get_bool' :vtable :method
+ .local pmc pos
+ pos = getattribute self, '$!pos'
+ $I0 = defined pos
+ .return ($I0)
+.end
+
+=item defined
+
+Synonim for C<get_bool>
+
+=cut
+
+.sub 'defined' :vtable :method
+ # Tailcall is broken...
+ # .return self.'get_bool'()
+ $I0 = self.'get_bool'()
+ .return ($I0)
+.end
+
+=item get_pos
+
+Get stored position with defaulting to 0 and issuing warning if undefined.
+
+=cut
+
+.sub 'get_pos' :method
+ .local pmc pos
+ pos = getattribute self, '$!pos'
+ $I0 = defined pos
+ if $I0 goto ret_val
+ # TODO Issue warning or call fail()
+ pos = 0
+ ret_val:
+ .return (pos)
+.end
+
+=item get_integer
+
+Integer version of C<get_pos>
+
+=cut
+
+.sub 'get_integer' :vtable :method
+ $P0 = self.'get_pos'()
+ $I0 = $P0
+ .return ($I0)
+.end
+
+=item get_string
+
+String version of C<get_pos>
+
+=cut
+
+.sub 'get_string' :vtable :method
+ $P0 = self.'get_pos'()
+ $S0 = $P0
+ .return ($S0)
+.end
+
+=back
+
# Local Variables:
# mode: pir
# fill-column: 100
|
From @bacekHello Sorry, I forgot about C<get_number> for StrPos. Updated patch attached. -- |
From @bacekstrpos2.diffdiff --git a/languages/perl6/src/builtins/any-str.pir b/languages/perl6/src/builtins/any-str.pir
index 3516a44..ba56169 100644
--- a/languages/perl6/src/builtins/any-str.pir
+++ b/languages/perl6/src/builtins/any-str.pir
@@ -46,6 +46,7 @@ the size of that file down and to emphasize their generic,
.param int pos :optional
.param int has_pos :opt_flag
.local pmc retv
+ .local pmc strposproto
if has_pos goto have_pos
pos = 0
@@ -54,6 +55,8 @@ the size of that file down and to emphasize their generic,
.local string s
s = self
+ strposproto = get_hll_global 'StrPos'
+
check_substring:
if substring goto substring_search
$I0 = length s
@@ -66,12 +69,11 @@ the size of that file down and to emphasize their generic,
if pos < 0 goto fail
done:
- $P0 = new 'Int'
- $P0 = pos
+ $P0 = strposproto.'new'('pos'=>pos)
.return ($P0)
fail:
- $P0 = new 'Failure'
+ $P0 = strposproto.'new'()
.return ($P0)
.end
diff --git a/languages/perl6/src/classes/Str.pir b/languages/perl6/src/classes/Str.pir
index bc36b82..cf2d25c 100644
--- a/languages/perl6/src/classes/Str.pir
+++ b/languages/perl6/src/classes/Str.pir
@@ -9,6 +9,8 @@ Str - Perl 6 Str class and related functions
This file sets up the C<Perl6Str> PMC type (from F<src/pmc/perl6str.pmc>)
as the Perl 6 C<Str> class.
+Also implements StrPos type as described in S29.
+
=head1 Methods
=over 4
@@ -20,7 +22,7 @@ as the Perl 6 C<Str> class.
.include 'cclass.pasm'
.sub 'onload' :anon :init :load
- .local pmc p6meta, strproto
+ .local pmc p6meta, strproto, strposproto
p6meta = get_hll_global ['Perl6Object'], '$!P6META'
strproto = p6meta.'new_class'('Str', 'parent'=>'Perl6Str Any')
p6meta.'register'('Perl6Str', 'parent'=>strproto, 'protoobject'=>strproto)
@@ -28,6 +30,8 @@ as the Perl 6 C<Str> class.
$P0 = get_hll_namespace ['Str']
'!EXPORT'('sprintf', 'from'=>$P0)
+
+ strproto = p6meta.'new_class'('StrPos', 'parent'=>'Any', 'attr'=>'$!pos')
.end
@@ -451,10 +455,6 @@ Note: Most users should just let their I/O handles autochomp instead.
This word is banned in Perl 6. You must specify units.
-=item index
-
-Needs to be in terms of StrPos, not Int.
-
=item pack
=item pos
@@ -482,6 +482,89 @@ Should replace vec with declared arrays of bit, uint2, uint4, etc.
=cut
+.namespace ['StrPos']
+
+=over
+
+=item get_bool
+
+=cut
+
+.sub 'get_bool' :vtable :method
+ .local pmc pos
+ pos = getattribute self, '$!pos'
+ $I0 = defined pos
+ .return ($I0)
+.end
+
+=item defined
+
+Synonim for C<get_bool>
+
+=cut
+
+.sub 'defined' :vtable :method
+ # Tailcall is broken...
+ # .return self.'get_bool'()
+ $I0 = self.'get_bool'()
+ .return ($I0)
+.end
+
+=item get_pos
+
+Get stored position with defaulting to 0 and issuing warning if undefined.
+
+=cut
+
+.sub 'get_pos' :method
+ .local pmc pos
+ pos = getattribute self, '$!pos'
+ $I0 = defined pos
+ if $I0 goto ret_val
+ # TODO Issue warning or call fail()
+ pos = 0
+ ret_val:
+ .return (pos)
+.end
+
+=item get_integer
+
+Integer version of C<get_pos>
+
+=cut
+
+.sub 'get_integer' :vtable :method
+ $P0 = self.'get_pos'()
+ $I0 = $P0
+ .return ($I0)
+.end
+
+=item get_number
+
+Number version of C<get_pos>
+
+=cut
+
+.sub 'get_number' :vtable :method
+ $P0 = self.'get_pos'()
+ $N0 = $P0
+ .return ($N0)
+.end
+
+=item get_string
+
+String version of C<get_pos>
+
+=cut
+
+.sub 'get_string' :vtable :method
+ $P0 = self.'get_pos'()
+ $S0 = $P0
+ .return ($S0)
+.end
+
+=back
+
# Local Variables:
# mode: pir
# fill-column: 100
|
@bacek - Status changed from 'new' to 'open' |
From @cokeOn Thu Aug 14 16:39:34 2008, bacek wrote:
bacek - this patch predates the migration of rakudo out of the parrot repository and no longer Sorry for the delay in replying. -- |
@coke - Status changed from 'open' to 'rejected' |
Migrated from rt.perl.org#57936 (status was 'rejected')
Searchable as RT57936$
The text was updated successfully, but these errors were encountered: