Author: coke Date: Wed Jul 23 17:39:50 2008 New Revision: 29714 Modified: trunk/languages/tcl/runtime/builtin/fileevent.pir trunk/languages/tcl/runtime/builtin/gets.pir trunk/languages/tcl/runtime/builtin/info.pir trunk/languages/tcl/runtime/builtin/lindex.pir trunk/languages/tcl/runtime/builtin/linsert.pir trunk/languages/tcl/runtime/builtin/lreplace.pir trunk/languages/tcl/runtime/builtin/lset.pir trunk/languages/tcl/runtime/builtin/puts.pir trunk/languages/tcl/runtime/builtin/string.pir trunk/languages/tcl/runtime/builtin/uplevel.pir trunk/languages/tcl/runtime/builtin/upvar.pir trunk/languages/tcl/runtime/conversions.pir trunk/languages/tcl/runtime/string_to_list.pir trunk/languages/tcl/src/builtin/lrange.tmt trunk/languages/tcl/src/grammar/expr/past.pir trunk/languages/tcl/src/tclsh.pir trunk/languages/tcl/tools/gen_inline.pl
Log: [tcl] http://code.google.com/p/partcl/issues/detail?id=58 Eliminate some more __foo style sub names Modified: trunk/languages/tcl/runtime/builtin/fileevent.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/fileevent.pir (original) +++ trunk/languages/tcl/runtime/builtin/fileevent.pir Wed Jul 23 17:39:50 2008 @@ -10,8 +10,8 @@ if argc < 2 goto badargs if argc > 3 goto badargs - .local pmc __channel, compileTcl - __channel = get_root_global ['_tcl'], '__channel' + .local pmc getChannel, compileTcl + getChannel = get_root_global ['_tcl'], 'getChannel' compileTcl = get_root_global ['_tcl'], 'compileTcl' .local pmc channel, script @@ -26,7 +26,7 @@ tcl_error $S0 readable: - channel = __channel(channel) + channel = getChannel(channel) if argc == 2 goto readable_2 @@ -47,7 +47,7 @@ .return('') writable: - channel = __channel(channel) + channel = getChannel(channel) .return('') badargs: Modified: trunk/languages/tcl/runtime/builtin/gets.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/gets.pir (original) +++ trunk/languages/tcl/runtime/builtin/gets.pir Wed Jul 23 17:39:50 2008 @@ -18,11 +18,11 @@ .local string channelID channelID = argv[0] - .local pmc __channel - __channel = get_root_global ['_tcl'], '__channel' + .local pmc getChannel + getChannel = get_root_global ['_tcl'], 'getChannel' .local pmc io - io = __channel(channelID) + io = getChannel(channelID) $S0 = typeof io if $S0 == 'TCPStream' goto stream Modified: trunk/languages/tcl/runtime/builtin/info.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/info.pir (original) +++ trunk/languages/tcl/runtime/builtin/info.pir Wed Jul 23 17:39:50 2008 @@ -474,15 +474,15 @@ .return($I0) find_level: - .local pmc toInteger, __call_level + .local pmc toInteger, getCallLevel toInteger = get_root_global ['_tcl'], 'toInteger' - __call_level = get_root_global ['_tcl'], '__call_level' + getCallLevel = get_root_global ['_tcl'], 'getCallLevel' .local pmc level level = shift argv level = toInteger(level) if level >= 0 goto find_info_level - level = __call_level(level) + level = getCallLevel(level) .return(level) find_info_level: Modified: trunk/languages/tcl/runtime/builtin/lindex.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/lindex.pir (original) +++ trunk/languages/tcl/runtime/builtin/lindex.pir Wed Jul 23 17:39:50 2008 @@ -11,9 +11,9 @@ argc = argv if argc < 1 goto bad_args - .local pmc toList, __index + .local pmc toList, getIndex toList = get_root_global ['_tcl'], 'toList' - __index = get_root_global ['_tcl'], '__index' + getIndex = get_root_global ['_tcl'], 'getIndex' .local pmc list list = argv[0] @@ -49,7 +49,7 @@ list = toList(list) $P0 = indices[$I1] - index = __index($P0, list) + index = getIndex($P0, list) $I2 = elements list if index >= $I2 goto empty Modified: trunk/languages/tcl/runtime/builtin/linsert.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/linsert.pir (original) +++ trunk/languages/tcl/runtime/builtin/linsert.pir Wed Jul 23 17:39:50 2008 @@ -22,11 +22,11 @@ .local string position position = shift argv - .local pmc __index - __index = get_root_global ['_tcl'], '__index' + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' .local int the_index - the_index = __index(position, the_list) + the_index = getIndex(position, the_list) $S0 = substr position, 0, 3 if $S0 != 'end' goto next Modified: trunk/languages/tcl/runtime/builtin/lreplace.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/lreplace.pir (original) +++ trunk/languages/tcl/runtime/builtin/lreplace.pir Wed Jul 23 17:39:50 2008 @@ -11,9 +11,9 @@ argc = elements argv if argc < 3 goto bad_args - .local pmc list, toList, retval, iterator, __index + .local pmc list, toList, retval, iterator, getIndex toList = get_root_global ['_tcl'], 'toList' - __index = get_root_global ['_tcl'], '__index' + getIndex = get_root_global ['_tcl'], 'getIndex' $P0 = shift argv list = toList($P0) list = clone list @@ -23,9 +23,9 @@ .local int first, last, count $S0 = shift argv - first = __index($S0,list) + first = getIndex($S0,list) $S0 = shift argv - last = __index($S0,list) + last = getIndex($S0,list) if size == 0 goto empty if last < size goto first_1 Modified: trunk/languages/tcl/runtime/builtin/lset.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/lset.pir (original) +++ trunk/languages/tcl/runtime/builtin/lset.pir Wed Jul 23 17:39:50 2008 @@ -31,8 +31,8 @@ if argc == 1 goto replace lset: - .local pmc __index - __index = get_root_global ['_tcl'], '__index' + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' unless argc == 2 goto iterate $P0 = argv[1] @@ -56,7 +56,7 @@ if $I0 == $I1 goto outer_loop $P0 = indices[$I0] - $I2 = __index($P0, list) + $I2 = getIndex($P0, list) if $I2 < 0 goto out_of_range $I3 = elements list if $I2 >= $I3 goto out_of_range Modified: trunk/languages/tcl/runtime/builtin/puts.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/puts.pir (original) +++ trunk/languages/tcl/runtime/builtin/puts.pir Wed Jul 23 17:39:50 2008 @@ -15,8 +15,8 @@ .local int utf8 utf8 = find_encoding 'utf8' - .local pmc __channel, io - __channel = get_root_global ['_tcl'], '__channel' + .local pmc getChannel, io + getChannel = get_root_global ['_tcl'], 'getChannel' if argc == 1 goto one_arg if argc == 2 goto two_arg @@ -26,7 +26,7 @@ if $S1 != '-nonewline' goto bad_option $S2 = argv[1] - io = __channel($S2) + io = getChannel($S2) $S3 = argv[2] $S3 = trans_encoding $S3, utf8 @@ -51,7 +51,7 @@ goto done two_arg_channel: - io = __channel($S2) + io = getChannel($S2) io.'say'($S3) goto done Modified: trunk/languages/tcl/runtime/builtin/string.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/string.pir (original) +++ trunk/languages/tcl/runtime/builtin/string.pir Wed Jul 23 17:39:50 2008 @@ -79,11 +79,11 @@ $I0 = 0 if argc == 2 goto first_do $S3 = argv[2] - .local pmc __index - __index = get_root_global ['_tcl'], '__index' - $I0 = __index($S3,$S2) + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' + $I0 = getIndex($S3,$S2) if $I0 >0 goto first_do - $I0 = 0 # XXX should this be done in __index? + $I0 = 0 # XXX should this be done in getIndex? first_do: .local int index_1 @@ -111,9 +111,9 @@ if argc == 2 goto last_do $S3 = argv[2] - .local pmc __index - __index = get_root_global ['_tcl'], '__index' - $I1 = __index($S3,$S2) + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' + $I1 = getIndex($S3,$S2) if $I1 > $I0 goto last_do $I0 = $I1 @@ -152,9 +152,9 @@ if argc != 2 goto bad_index $S1 = argv[0] $S2 = argv[1] - .local pmc __index - __index = get_root_global ['_tcl'], '__index' - $I0 = __index($S2,$S1) + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' + $I0 = getIndex($S2,$S1) index_1 = length $S1 inc index_1 if $I0 > index_1 goto index_null @@ -191,17 +191,17 @@ $I3 = $I1 if argc == 1 goto tolower_do - .local pmc __index - __index = get_root_global ['_tcl'], '__index' + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' $S2 = argv[1] - $I2 = __index($S2, $S1) + $I2 = getIndex($S2, $S1) # if just the first is specified, the last is the same (tclsh says so) $I3 = $I2 if argc == 2 goto tolower_do $S3 = argv[2] - $I3 = __index($S3, $S1) + $I3 = getIndex($S3, $S1) tolower_do: if $I2 > $I1 goto tolower_return @@ -244,17 +244,17 @@ $I3 = $I1 if argc == 1 goto toupper_do - .local pmc __index - __index = get_root_global ['_tcl'], '__index' + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' $S2 = argv[1] - $I2 = __index($S2, $S1) + $I2 = getIndex($S2, $S1) # if just the first is specified, the last is the same (tclsh says so) $I3 = $I2 if argc == 2 goto toupper_do $S3 = argv[2] - $I3 = __index($S3, $S1) + $I3 = getIndex($S3, $S1) toupper_do: if $I2 > $I1 goto toupper_return @@ -296,17 +296,17 @@ $I3 = $I1 if argc == 1 goto totitle_do - .local pmc __index - __index = get_root_global ['_tcl'], '__index' + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' $S2 = argv[1] - $I2 = __index($S2, $S1) + $I2 = getIndex($S2, $S1) # if just the first is specified, the last is the same (tclsh says so) $I3 = $I2 if argc == 2 goto totitle_do $S3 = argv[2] - $I3 = __index($S3, $S1) + $I3 = getIndex($S3, $S1) totitle_do: if $I2 > $I1 goto totitle_return @@ -376,12 +376,12 @@ last_index = length teh_string dec last_index - .local pmc __index - __index = get_root_global ['_tcl'], '__index' + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' .local int first_i, last_i - first_i = __index(first_s, teh_string) - last_i = __index(last_s, teh_string) + first_i = getIndex(first_s, teh_string) + last_i = getIndex(last_s, teh_string) if first_i > last_i goto done @@ -827,8 +827,8 @@ .local int len .local pmc retval - .local pmc __index - __index = get_root_global ['_tcl'], '__index' + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' argc = argv if argc > 4 goto bad_args @@ -842,12 +842,12 @@ $S4 = '' low_s = argv[1] - low = __index(low_s, the_string) + low = getIndex(low_s, the_string) if low >= string_len goto replace_done high_s = argv[2] - high = __index(high_s, the_string) + high = getIndex(high_s, the_string) if high < low goto replace_done @@ -1091,9 +1091,9 @@ str = argv[0] idx = argv[1] - .local pmc __index - __index = get_root_global ['_tcl'], '__index' - idx = __index(idx, str) + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' + idx = getIndex(idx, str) $I0 = length str $I0 -= idx @@ -1121,13 +1121,13 @@ str = argv[0] idx = argv[1] - .local pmc __index - __index = get_root_global ['_tcl'], '__index' - idx = __index(idx, str) + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' + idx = getIndex(idx, str) .local int pos pos = idx - # XXX should these checks be in __index itself? + # XXX should these checks be in getIndex itself? if pos >0 goto check_upper pos = 0 goto pre_loop Modified: trunk/languages/tcl/runtime/builtin/uplevel.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/uplevel.pir (original) +++ trunk/languages/tcl/runtime/builtin/uplevel.pir Wed Jul 23 17:39:50 2008 @@ -14,9 +14,9 @@ argc = elements argv if argc == 0 goto bad_args - .local pmc compileTcl, __call_level + .local pmc compileTcl, getCallLevel compileTcl = get_root_global ['_tcl'], 'compileTcl' - __call_level = get_root_global ['_tcl'], '__call_level' + getCallLevel = get_root_global ['_tcl'], 'getCallLevel' # save the old call level .local pmc call_chain @@ -28,7 +28,7 @@ new_call_level = argv[0] .local int defaulted - (new_call_level,defaulted) = __call_level(new_call_level) + (new_call_level,defaulted) = getCallLevel(new_call_level) if defaulted == 1 goto skip # if we only have a level, then we don't have a command to run! Modified: trunk/languages/tcl/runtime/builtin/upvar.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/upvar.pir (original) +++ trunk/languages/tcl/runtime/builtin/upvar.pir Wed Jul 23 17:39:50 2008 @@ -11,15 +11,15 @@ argc = elements argv if argc < 2 goto bad_args - .local pmc __call_level, call_chain + .local pmc getCallLevel, call_chain .local int call_level - __call_level = get_root_global ['_tcl'], '__call_level' + getCallLevel = get_root_global ['_tcl'], 'getCallLevel' call_chain = get_root_global ['_tcl'], 'call_chain' call_level = elements call_chain .local int new_call_level, defaulted $P0 = argv[0] - (new_call_level,defaulted) = __call_level($P0) + (new_call_level,defaulted) = getCallLevel($P0) if defaulted == 1 goto skip $P1 = shift argv dec argc Modified: trunk/languages/tcl/runtime/conversions.pir ============================================================================== --- trunk/languages/tcl/runtime/conversions.pir (original) +++ trunk/languages/tcl/runtime/conversions.pir Wed Jul 23 17:39:50 2008 @@ -57,7 +57,7 @@ .sub toDict :multi(_) .param pmc value - $P0 = __stringToDict(value) + $P0 = stringToDict(value) copy value, $P0 .return(value) @@ -185,14 +185,14 @@ rethrow $P99 # preserves the invalid octal message. .end -=head2 _Tcl::__index +=head2 _Tcl::getIndex Given a tcl string index and an List pmc, return the corresponding numeric index. =cut -.sub __index +.sub getIndex .param string idx .param pmc list @@ -249,13 +249,13 @@ tcl_error $S0 .end -=head2 _Tcl::__channel +=head2 _Tcl::getChannel Given a string, return the appropriate channel. =cut -.sub __channel +.sub getChannel .param string channelID .local pmc channels @@ -583,7 +583,7 @@ .return(0) .end -=head2 _Tcl::__call_level +=head2 _Tcl::getCallLevel Given a pmc containing the tcl-style call level, return an int-like pmc indicating the parrot-style level, and an integer with a boolean 0/1 - @@ -591,7 +591,7 @@ =cut -.sub __call_level +.sub getCallLevel .param pmc tcl_level .local pmc parrot_level, defaulted, orig_level defaulted = new 'Integer' Modified: trunk/languages/tcl/runtime/string_to_list.pir ============================================================================== --- trunk/languages/tcl/runtime/string_to_list.pir (original) +++ trunk/languages/tcl/runtime/string_to_list.pir Wed Jul 23 17:39:50 2008 @@ -53,7 +53,7 @@ tcl_error 'missing value to go with key' .end -.sub __stringToDict +.sub stringToDict .param string str .local pmc list Modified: trunk/languages/tcl/src/builtin/lrange.tmt ============================================================================== --- trunk/languages/tcl/src/builtin/lrange.tmt (original) +++ trunk/languages/tcl/src/builtin/lrange.tmt Wed Jul 23 17:39:50 2008 @@ -1,11 +1,11 @@ [lrange list:list first last] - .local pmc __index - __index = get_root_global ['_tcl'], '__index' + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' .local int from, to - from = __index($first, $list) - to = __index($last, $list) + from = getIndex($first, $list) + to = getIndex($last, $list) if from < 0 goto set_first have_first: Modified: trunk/languages/tcl/src/grammar/expr/past.pir ============================================================================== --- trunk/languages/tcl/src/grammar/expr/past.pir (original) +++ trunk/languages/tcl/src/grammar/expr/past.pir Wed Jul 23 17:39:50 2008 @@ -29,13 +29,13 @@ .namespace [ 'PAST' ] -=item C<__onload()> +=item C<onload()> Creates the C<PAST::*> classes. =cut -.sub '__onload' :load +.sub 'onload' :load :anon .local pmc base $P0 = get_class 'Hash' base = subclass $P0, 'PAST::Node' @@ -66,7 +66,7 @@ =over 4 -=item C<__init()> +=item C<init()> Initializes a new C<PAST::Node> object. Modified: trunk/languages/tcl/src/tclsh.pir ============================================================================== --- trunk/languages/tcl/src/tclsh.pir (original) +++ trunk/languages/tcl/src/tclsh.pir Wed Jul 23 17:39:50 2008 @@ -82,7 +82,7 @@ .local int level level = 1 input_loop: - $P0 = __prompt(level, readlineInd) + $P0 = prompt(level, readlineInd) if null $P0 goto done $S0 = $P0 $S0 .= "\n" # add back in the newline the prompt chomped @@ -198,7 +198,7 @@ .rethrow() .end -.sub __prompt +.sub prompt .param int level .param int readlineInd Modified: trunk/languages/tcl/tools/gen_inline.pl ============================================================================== --- trunk/languages/tcl/tools/gen_inline.pl (original) +++ trunk/languages/tcl/tools/gen_inline.pl Wed Jul 23 17:39:50 2008 @@ -37,7 +37,7 @@ # type subroutine bool => 'toBoolean', - channel => '__channel', + channel => 'getChannel', expr => 'compileExpr', int => 'toInteger', list => 'toList',
