From 3749f5a1873fb3c57f3815be8254f6328908e3da Mon Sep 17 00:00:00 2001 From: Coke Date: Fri, 2 Apr 2010 19:57:06 -0400 Subject: [PATCH] Convert TclList's 'get_string' vtable from PIR to NQP --- src/TclList.pm | 105 ++++++++++++++++++++++++++++- src/class/tcllist.pir | 149 ------------------------------------------ 2 files changed, 104 insertions(+), 150 deletions(-) diff --git a/src/TclList.pm b/src/TclList.pm index ddb49d0..c854924 100644 --- a/src/TclList.pm +++ b/src/TclList.pm @@ -9,6 +9,8 @@ INIT { $core := pir::get_class__ps('ResizableStringArray'), $interp.hll_map($core, $tcl); + + $tcl.add_vtable_override('get_string', TclList::get_string) } module TclList { @@ -52,6 +54,107 @@ module TclList { } return self; } -} + + method get_string() { + my @retval := (); + + my $first := 1; + my $self := self; + + for self -> $element { + my $elem_length := pir::length__is($element); + my $new_s := ''; + + if $elem_length == 0 { + $new_s := '{}'; + } else { + my $count := 0; + my $pos := 0; + my $brace_check_pos := 0; + my $has_braces := 0; + + my $escaped := 0; + + while $pos < $elem_length && !$escaped { + my $char := pir::ord__isi($element, $pos); + if $char == 0x7b { # open brace + $count++; + $has_braces := 1; + } elsif $char == 0x7d { # close brace + $count--; + if $count < 0 { + $new_s := self.'escape_element'($element); + $escaped := 1; + } else { + $brace_check_pos := +$pos; + } + } + $pos++; + } + + unless $escaped { + if $count { + $new_s := self.'escape_element'($element); + } else { + + if $has_braces && $brace_check_pos != $elem_length -1 { + if $brace_check_pos != $elem_length -2 { + $new_s := '{' ~ $element ~ '}'; + } elsif pir::ord__isi($element,$elem_length-1) != 0x5c { + # 0x5c == backslash + $new_s := '{' ~ $element ~ '}'; + } else { + $new_s := self.'escape_element'($element); + } + } elsif $elem_length -1 == pir::index__issi($element,"\\", $elem_length-1) { + $new_s := self.'escape_element'($element); + } elsif pir::index__iss($element, '"') != -1 { + $new_s := '{' ~ $element ~ '}'; + } elsif pir::index__iss($element, '[') != -1 { + $new_s := '{' ~ $element ~ '}'; + } elsif $first && pir::index__iss($element, '#') != -1 { + $new_s := '{' ~ $element ~ '}'; + } elsif pir::index__iss($element, '$') != -1 { + $new_s := '{' ~ $element ~ '}'; + } elsif pir::index__iss($element, ';') != -1 { + $new_s := '{' ~ $element ~ '}'; + } elsif pir::index__iss($element, ']') != -1 { + $new_s := self.'escape_element'($element); + } elsif pir::find_cclass__iisii(32, $element, 0, $elem_length) != $elem_length { + # .macro_const CCLASS_WHITESPACE 32 + $new_s := '{' ~ $element ~ '}'; + } else { + $new_s := $element + } + } + } + } + + @retval.push($new_s); + $first := 0; + } + + return pir::join__ssp(' ', @retval); + } + + method escape_element($string) { + my $repl := ~$string; + $repl.replace("\\", "\\\\"); + $repl.replace("\t", "\\t"); + $repl.replace("\f", "\\f"); + $repl.replace("\n", "\\n"); + $repl.replace("\r", "\\r"); + $repl.replace("\v", "\\v"); + $repl.replace("\;", "\\;" ); + $repl.replace('$', "\\\$" ); + $repl.replace('{', "\\\x7b" ); + $repl.replace('}', "\\\x7d" ); + $repl.replace(' ', "\\ " ); + $repl.replace('[', "\\[" ); + $repl.replace(']', "\\]" ); + $repl.replace('"', "\\\""); + return $repl; + } +} # vim: filetype=perl6: diff --git a/src/class/tcllist.pir b/src/class/tcllist.pir index 4ba0709..b99757f 100644 --- a/src/class/tcllist.pir +++ b/src/class/tcllist.pir @@ -4,8 +4,6 @@ A Tcl-style list =cut -.include 'cclass.pasm' - .HLL 'tcl' .namespace [ 'TclList' ] @@ -14,150 +12,3 @@ A Tcl-style list core = get_class 'ResizablePMCArray' tcl = subclass core, 'TclList' .end - -=head2 get_string - -Returns the list as a string - -=cut - -.sub get_string :vtable - .local pmc retval - retval = new 'ResizablePMCArray' - - .local int elems - elems = self - - .local pmc iterator - iterator = iter self - - .local string elem_s - .local int elem_len - .local string new_s - - .local int first_elem - first_elem = 1 - loop: - unless iterator goto done - elem_s = shift iterator - elem_len = length elem_s - - if elem_len != 0 goto has_length - new_s = '{}' - goto append_elem - - has_length: - .local int count, pos, brace_check_pos, has_braces - count = 0 - pos = 0 - brace_check_pos = 0 - has_braces = 0 - - .local int char - elem_loop: - if pos >= elem_len goto elem_loop_done - char = ord elem_s, pos - if char == 0x7b goto open_count - if char == 0x7d goto close_count - goto elem_loop_next - open_count: - inc count - has_braces = 1 - goto elem_loop_next - close_count: - dec count - if count < 0 goto escape - brace_check_pos = pos - elem_loop_next: - inc pos - goto elem_loop - elem_loop_done: - - if count goto escape - unless has_braces goto done_brace_check - if count goto done_brace_check - $I0 = elem_len - 1 - if brace_check_pos == $I0 goto done_brace_check - - # escape {ab}\, but brace-wrap anything else. - $I0 = elem_len - 2 - if brace_check_pos != $I0 goto quote - $I0 = elem_len - 1 - char = ord elem_s, $I0 - if char != 0x5c goto quote - - goto escape - - done_brace_check: - # trailing slash - $I0 = elem_len - 1 - $I1 = index elem_s, "\\", $I0 - if $I0 == $I1 goto escape - - $I0 = index elem_s, "\"" - if $I0 != -1 goto quote - - $I0 = index elem_s, '[' - if $I0 != -1 goto quote - - # only check hashes on first elem. - unless first_elem goto done_hash - $I0 = index elem_s, '#' - if $I0 != -1 goto quote - - done_hash: - $I0 = index elem_s, '$' - if $I0 != -1 goto quote - - $I0 = index elem_s, ';' - if $I0 != -1 goto quote - - # \'d constructs - $I0 = index elem_s, ']' - if $I0 != -1 goto escape - - $I0 = index elem_s, "\\" - if $I0 != -1 goto escape - - # {}'d constructs - $I0 = find_cclass .CCLASS_WHITESPACE, elem_s, 0, elem_len - if elem_len != $I0 goto quote - - new_s = elem_s - goto append_elem - - escape: - .local pmc string_t - string_t = new 'String' - string_t = elem_s - string_t.'replace'("\\", "\\\\") - string_t.'replace'("\t", "\\t") - string_t.'replace'("\f", "\\f") - string_t.'replace'("\n", "\\n") - string_t.'replace'("\r", "\\r") - string_t.'replace'("\v", "\\v") - string_t.'replace'("\;", "\\;" ) - string_t.'replace'("$", "\\$" ) - string_t.'replace'("}", "\\}" ) - string_t.'replace'("{", "\\{" ) - string_t.'replace'(" ", "\\ " ) - string_t.'replace'("[", "\\[" ) - string_t.'replace'("]", "\\]" ) - string_t.'replace'("\"", "\\\"") - new_s = string_t - goto append_elem - - quote: - new_s = '{' . elem_s - new_s = new_s . '}' - - append_elem: - push retval, new_s - first_elem = 0 - goto loop - - done: - .local string retval_s - retval_s = join " ", retval - .return(retval_s) -.end