Revision 29714

Date:
2008/07/24 00:39:50
Author:
coke
Revision Log:
[tcl] http://code.google.com/p/partcl/issues/detail?id=58
Eliminate some more __foo style sub names
Files:

Legend:

 
Added
 
Removed
 
Modified

  • trunk/languages/tcl/runtime/builtin/fileevent.pir

     
    10 10 if argc < 2 goto badargs
    11 11 if argc > 3 goto badargs
    12 12
    13 .local pmc __channel, compileTcl
    14 __channel = get_root_global ['_tcl'], '__channel'
    13 .local pmc getChannel, compileTcl
    14 getChannel = get_root_global ['_tcl'], 'getChannel'
    15 15 compileTcl = get_root_global ['_tcl'], 'compileTcl'
    16 16
    17 17 .local pmc channel, script
    … …  
    26 26 tcl_error $S0
    27 27
    28 28 readable:
    29 channel = __channel(channel)
    29 channel = getChannel(channel)
    30 30
    31 31 if argc == 2 goto readable_2
    32 32
    … …  
    47 47 .return('')
    48 48
    49 49 writable:
    50 channel = __channel(channel)
    50 channel = getChannel(channel)
    51 51 .return('')
    52 52
    53 53 badargs:

  • trunk/languages/tcl/runtime/builtin/gets.pir

     
    18 18 .local string channelID
    19 19 channelID = argv[0]
    20 20
    21 .local pmc __channel
    22 __channel = get_root_global ['_tcl'], '__channel'
    21 .local pmc getChannel
    22 getChannel = get_root_global ['_tcl'], 'getChannel'
    23 23
    24 24 .local pmc io
    25 io = __channel(channelID)
    25 io = getChannel(channelID)
    26 26
    27 27 $S0 = typeof io
    28 28 if $S0 == 'TCPStream' goto stream

  • trunk/languages/tcl/runtime/builtin/info.pir

     
    474 474 .return($I0)
    475 475
    476 476 find_level:
    477 .local pmc toInteger, __call_level
    477 .local pmc toInteger, getCallLevel
    478 478 toInteger = get_root_global ['_tcl'], 'toInteger'
    479 __call_level = get_root_global ['_tcl'], '__call_level'
    479 getCallLevel = get_root_global ['_tcl'], 'getCallLevel'
    480 480
    481 481 .local pmc level
    482 482 level = shift argv
    483 483 level = toInteger(level)
    484 484 if level >= 0 goto find_info_level
    485 level = __call_level(level)
    485 level = getCallLevel(level)
    486 486 .return(level)
    487 487
    488 488 find_info_level:

  • trunk/languages/tcl/runtime/builtin/lindex.pir

     
    11 11 argc = argv
    12 12 if argc < 1 goto bad_args
    13 13
    14 .local pmc toList, __index
    14 .local pmc toList, getIndex
    15 15 toList = get_root_global ['_tcl'], 'toList'
    16 __index = get_root_global ['_tcl'], '__index'
    16 getIndex = get_root_global ['_tcl'], 'getIndex'
    17 17
    18 18 .local pmc list
    19 19 list = argv[0]
    … …  
    49 49 list = toList(list)
    50 50
    51 51 $P0 = indices[$I1]
    52 index = __index($P0, list)
    52 index = getIndex($P0, list)
    53 53
    54 54 $I2 = elements list
    55 55 if index >= $I2 goto empty

  • trunk/languages/tcl/runtime/builtin/linsert.pir

     
    22 22 .local string position
    23 23 position = shift argv
    24 24
    25 .local pmc __index
    26 __index = get_root_global ['_tcl'], '__index'
    25 .local pmc getIndex
    26 getIndex = get_root_global ['_tcl'], 'getIndex'
    27 27
    28 28 .local int the_index
    29 the_index = __index(position, the_list)
    29 the_index = getIndex(position, the_list)
    30 30
    31 31 $S0 = substr position, 0, 3
    32 32 if $S0 != 'end' goto next

  • trunk/languages/tcl/runtime/builtin/lreplace.pir

     
    11 11 argc = elements argv
    12 12 if argc < 3 goto bad_args
    13 13
    14 .local pmc list, toList, retval, iterator, __index
    14 .local pmc list, toList, retval, iterator, getIndex
    15 15 toList = get_root_global ['_tcl'], 'toList'
    16 __index = get_root_global ['_tcl'], '__index'
    16 getIndex = get_root_global ['_tcl'], 'getIndex'
    17 17 $P0 = shift argv
    18 18 list = toList($P0)
    19 19 list = clone list
    … …  
    23 23
    24 24 .local int first, last, count
    25 25 $S0 = shift argv
    26 first = __index($S0,list)
    26 first = getIndex($S0,list)
    27 27 $S0 = shift argv
    28 last = __index($S0,list)
    28 last = getIndex($S0,list)
    29 29
    30 30 if size == 0 goto empty
    31 31 if last < size goto first_1

  • trunk/languages/tcl/runtime/builtin/lset.pir

     
    31 31 if argc == 1 goto replace
    32 32
    33 33 lset:
    34 .local pmc __index
    35 __index = get_root_global ['_tcl'], '__index'
    34 .local pmc getIndex
    35 getIndex = get_root_global ['_tcl'], 'getIndex'
    36 36
    37 37 unless argc == 2 goto iterate
    38 38 $P0 = argv[1]
    … …  
    56 56 if $I0 == $I1 goto outer_loop
    57 57
    58 58 $P0 = indices[$I0]
    59 $I2 = __index($P0, list)
    59 $I2 = getIndex($P0, list)
    60 60 if $I2 < 0 goto out_of_range
    61 61 $I3 = elements list
    62 62 if $I2 >= $I3 goto out_of_range

  • trunk/languages/tcl/runtime/builtin/puts.pir

     
    15 15 .local int utf8
    16 16 utf8 = find_encoding 'utf8'
    17 17
    18 .local pmc __channel, io
    19 __channel = get_root_global ['_tcl'], '__channel'
    18 .local pmc getChannel, io
    19 getChannel = get_root_global ['_tcl'], 'getChannel'
    20 20
    21 21 if argc == 1 goto one_arg
    22 22 if argc == 2 goto two_arg
    … …  
    26 26 if $S1 != '-nonewline' goto bad_option
    27 27
    28 28 $S2 = argv[1]
    29 io = __channel($S2)
    29 io = getChannel($S2)
    30 30 $S3 = argv[2]
    31 31 $S3 = trans_encoding $S3, utf8
    32 32
    … …  
    51 51 goto done
    52 52
    53 53 two_arg_channel:
    54 io = __channel($S2)
    54 io = getChannel($S2)
    55 55
    56 56 io.'say'($S3)
    57 57 goto done

  • trunk/languages/tcl/runtime/builtin/string.pir

     
    79 79 $I0 = 0
    80 80 if argc == 2 goto first_do
    81 81 $S3 = argv[2]
    82 .local pmc __index
    83 __index = get_root_global ['_tcl'], '__index'
    84 $I0 = __index($S3,$S2)
    82 .local pmc getIndex
    83 getIndex = get_root_global ['_tcl'], 'getIndex'
    84 $I0 = getIndex($S3,$S2)
    85 85 if $I0 >0 goto first_do
    86 $I0 = 0 # XXX should this be done in __index?
    86 $I0 = 0 # XXX should this be done in getIndex?
    87 87
    88 88 first_do:
    89 89 .local int index_1
    … …  
    111 111 if argc == 2 goto last_do
    112 112
    113 113 $S3 = argv[2]
    114 .local pmc __index
    115 __index = get_root_global ['_tcl'], '__index'
    116 $I1 = __index($S3,$S2)
    114 .local pmc getIndex
    115 getIndex = get_root_global ['_tcl'], 'getIndex'
    116 $I1 = getIndex($S3,$S2)
    117 117
    118 118 if $I1 > $I0 goto last_do
    119 119 $I0 = $I1
    … …  
    152 152 if argc != 2 goto bad_index
    153 153 $S1 = argv[0]
    154 154 $S2 = argv[1]
    155 .local pmc __index
    156 __index = get_root_global ['_tcl'], '__index'
    157 $I0 = __index($S2,$S1)
    155 .local pmc getIndex
    156 getIndex = get_root_global ['_tcl'], 'getIndex'
    157 $I0 = getIndex($S2,$S1)
    158 158 index_1 = length $S1
    159 159 inc index_1
    160 160 if $I0 > index_1 goto index_null
    … …  
    191 191 $I3 = $I1
    192 192 if argc == 1 goto tolower_do
    193 193
    194 .local pmc __index
    195 __index = get_root_global ['_tcl'], '__index'
    194 .local pmc getIndex
    195 getIndex = get_root_global ['_tcl'], 'getIndex'
    196 196
    197 197 $S2 = argv[1]
    198 $I2 = __index($S2, $S1)
    198 $I2 = getIndex($S2, $S1)
    199 199 # if just the first is specified, the last is the same (tclsh says so)
    200 200 $I3 = $I2
    201 201 if argc == 2 goto tolower_do
    202 202
    203 203 $S3 = argv[2]
    204 $I3 = __index($S3, $S1)
    204 $I3 = getIndex($S3, $S1)
    205 205
    206 206 tolower_do:
    207 207 if $I2 > $I1 goto tolower_return
    … …  
    244 244 $I3 = $I1
    245 245 if argc == 1 goto toupper_do
    246 246
    247 .local pmc __index
    248 __index = get_root_global ['_tcl'], '__index'
    247 .local pmc getIndex
    248 getIndex = get_root_global ['_tcl'], 'getIndex'
    249 249
    250 250 $S2 = argv[1]
    251 $I2 = __index($S2, $S1)
    251 $I2 = getIndex($S2, $S1)
    252 252 # if just the first is specified, the last is the same (tclsh says so)
    253 253 $I3 = $I2
    254 254 if argc == 2 goto toupper_do
    255 255
    256 256 $S3 = argv[2]
    257 $I3 = __index($S3, $S1)
    257 $I3 = getIndex($S3, $S1)
    258 258
    259 259 toupper_do:
    260 260 if $I2 > $I1 goto toupper_return
    … …  
    296 296 $I3 = $I1
    297 297 if argc == 1 goto totitle_do
    298 298
    299 .local pmc __index
    300 __index = get_root_global ['_tcl'], '__index'
    299 .local pmc getIndex
    300 getIndex = get_root_global ['_tcl'], 'getIndex'
    301 301
    302 302 $S2 = argv[1]
    303 $I2 = __index($S2, $S1)
    303 $I2 = getIndex($S2, $S1)
    304 304 # if just the first is specified, the last is the same (tclsh says so)
    305 305 $I3 = $I2
    306 306 if argc == 2 goto totitle_do
    307 307
    308 308 $S3 = argv[2]
    309 $I3 = __index($S3, $S1)
    309 $I3 = getIndex($S3, $S1)
    310 310
    311 311 totitle_do:
    312 312 if $I2 > $I1 goto totitle_return
    … …  
    376 376 last_index = length teh_string
    377 377 dec last_index
    378 378
    379 .local pmc __index
    380 __index = get_root_global ['_tcl'], '__index'
    379 .local pmc getIndex
    380 getIndex = get_root_global ['_tcl'], 'getIndex'
    381 381
    382 382 .local int first_i, last_i
    383 first_i = __index(first_s, teh_string)
    384 last_i = __index(last_s, teh_string)
    383 first_i = getIndex(first_s, teh_string)
    384 last_i = getIndex(last_s, teh_string)
    385 385
    386 386 if first_i > last_i goto done
    387 387
    … …  
    827 827 .local int len
    828 828 .local pmc retval
    829 829
    830 .local pmc __index
    831 __index = get_root_global ['_tcl'], '__index'
    830 .local pmc getIndex
    831 getIndex = get_root_global ['_tcl'], 'getIndex'
    832 832
    833 833 argc = argv
    834 834 if argc > 4 goto bad_args
    … …  
    842 842 $S4 = ''
    843 843
    844 844 low_s = argv[1]
    845 low = __index(low_s, the_string)
    845 low = getIndex(low_s, the_string)
    846 846
    847 847 if low >= string_len goto replace_done
    848 848
    849 849 high_s = argv[2]
    850 high = __index(high_s, the_string)
    850 high = getIndex(high_s, the_string)
    851 851
    852 852 if high < low goto replace_done
    853 853
    … …  
    1091 1091 str = argv[0]
    1092 1092 idx = argv[1]
    1093 1093
    1094 .local pmc __index
    1095 __index = get_root_global ['_tcl'], '__index'
    1096 idx = __index(idx, str)
    1094 .local pmc getIndex
    1095 getIndex = get_root_global ['_tcl'], 'getIndex'
    1096 idx = getIndex(idx, str)
    1097 1097
    1098 1098 $I0 = length str
    1099 1099 $I0 -= idx
    … …  
    1121 1121 str = argv[0]
    1122 1122 idx = argv[1]
    1123 1123
    1124 .local pmc __index
    1125 __index = get_root_global ['_tcl'], '__index'
    1126 idx = __index(idx, str)
    1124 .local pmc getIndex
    1125 getIndex = get_root_global ['_tcl'], 'getIndex'
    1126 idx = getIndex(idx, str)
    1127 1127
    1128 1128 .local int pos
    1129 1129 pos = idx
    1130 # XXX should these checks be in __index itself?
    1130 # XXX should these checks be in getIndex itself?
    1131 1131 if pos >0 goto check_upper
    1132 1132 pos = 0
    1133 1133 goto pre_loop

  • trunk/languages/tcl/runtime/builtin/uplevel.pir

     
    14 14 argc = elements argv
    15 15 if argc == 0 goto bad_args
    16 16
    17 .local pmc compileTcl, __call_level
    17 .local pmc compileTcl, getCallLevel
    18 18 compileTcl = get_root_global ['_tcl'], 'compileTcl'
    19 __call_level = get_root_global ['_tcl'], '__call_level'
    19 getCallLevel = get_root_global ['_tcl'], 'getCallLevel'
    20 20
    21 21 # save the old call level
    22 22 .local pmc call_chain
    … …  
    28 28 new_call_level = argv[0]
    29 29
    30 30 .local int defaulted
    31 (new_call_level,defaulted) = __call_level(new_call_level)
    31 (new_call_level,defaulted) = getCallLevel(new_call_level)
    32 32 if defaulted == 1 goto skip
    33 33
    34 34 # if we only have a level, then we don't have a command to run!

  • trunk/languages/tcl/runtime/builtin/upvar.pir

     
    11 11 argc = elements argv
    12 12 if argc < 2 goto bad_args
    13 13
    14 .local pmc __call_level, call_chain
    14 .local pmc getCallLevel, call_chain
    15 15 .local int call_level
    16 __call_level = get_root_global ['_tcl'], '__call_level'
    16 getCallLevel = get_root_global ['_tcl'], 'getCallLevel'
    17 17 call_chain = get_root_global ['_tcl'], 'call_chain'
    18 18 call_level = elements call_chain
    19 19
    20 20 .local int new_call_level, defaulted
    21 21 $P0 = argv[0]
    22 (new_call_level,defaulted) = __call_level($P0)
    22 (new_call_level,defaulted) = getCallLevel($P0)
    23 23 if defaulted == 1 goto skip
    24 24 $P1 = shift argv
    25 25 dec argc

  • trunk/languages/tcl/runtime/conversions.pir

     
    57 57 .sub toDict :multi(_)
    58 58 .param pmc value
    59 59
    60 $P0 = __stringToDict(value)
    60 $P0 = stringToDict(value)
    61 61 copy value, $P0
    62 62
    63 63 .return(value)
    … …  
    185 185 rethrow $P99 # preserves the invalid octal message.
    186 186 .end
    187 187
    188 =head2 _Tcl::__index
    188 =head2 _Tcl::getIndex
    189 189
    190 190 Given a tcl string index and an List pmc, return the corresponding numeric
    191 191 index.
    192 192
    193 193 =cut
    194 194
    195 .sub __index
    195 .sub getIndex
    196 196 .param string idx
    197 197 .param pmc list
    198 198
    … …  
    249 249 tcl_error $S0
    250 250 .end
    251 251
    252 =head2 _Tcl::__channel
    252 =head2 _Tcl::getChannel
    253 253
    254 254 Given a string, return the appropriate channel.
    255 255
    256 256 =cut
    257 257
    258 .sub __channel
    258 .sub getChannel
    259 259 .param string channelID
    260 260
    261 261 .local pmc channels
    … …  
    583 583 .return(0)
    584 584 .end
    585 585
    586 =head2 _Tcl::__call_level
    586 =head2 _Tcl::getCallLevel
    587 587
    588 588 Given a pmc containing the tcl-style call level, return an int-like pmc
    589 589 indicating the parrot-style level, and an integer with a boolean 0/1 -
    … …  
    591 591
    592 592 =cut
    593 593
    594 .sub __call_level
    594 .sub getCallLevel
    595 595 .param pmc tcl_level
    596 596 .local pmc parrot_level, defaulted, orig_level
    597 597 defaulted = new 'Integer'

  • trunk/languages/tcl/runtime/string_to_list.pir

     
    53 53 tcl_error 'missing value to go with key'
    54 54 .end
    55 55
    56 .sub __stringToDict
    56 .sub stringToDict
    57 57 .param string str
    58 58
    59 59 .local pmc list

  • trunk/languages/tcl/src/builtin/lrange.tmt

     
    1 1 [lrange list:list first last]
    2 2
    3 .local pmc __index
    4 __index = get_root_global ['_tcl'], '__index'
    3 .local pmc getIndex
    4 getIndex = get_root_global ['_tcl'], 'getIndex'
    5 5
    6 6 .local int from, to
    7 from = __index($first, $list)
    8 to = __index($last, $list)
    7 from = getIndex($first, $list)
    8 to = getIndex($last, $list)
    9 9
    10 10 if from < 0 goto set_first
    11 11 have_first:

  • trunk/languages/tcl/src/grammar/expr/past.pir

     
    29 29
    30 30 .namespace [ 'PAST' ]
    31 31
    32 =item C<__onload()>
    32 =item C<onload()>
    33 33
    34 34 Creates the C<PAST::*> classes.
    35 35
    36 36 =cut
    37 37
    38 .sub '__onload' :load
    38 .sub 'onload' :load :anon
    39 39 .local pmc base
    40 40 $P0 = get_class 'Hash'
    41 41 base = subclass $P0, 'PAST::Node'
    … …  
    66 66
    67 67 =over 4
    68 68
    69 =item C<__init()>
    69 =item C<init()>
    70 70
    71 71 Initializes a new C<PAST::Node> object.
    72 72

  • trunk/languages/tcl/src/tclsh.pir

     
    82 82 .local int level
    83 83 level = 1
    84 84 input_loop:
    85 $P0 = __prompt(level, readlineInd)
    85 $P0 = prompt(level, readlineInd)
    86 86 if null $P0 goto done
    87 87 $S0 = $P0
    88 88 $S0 .= "\n" # add back in the newline the prompt chomped
    … …  
    198 198 .rethrow()
    199 199 .end
    200 200
    201 .sub __prompt
    201 .sub prompt
    202 202 .param int level
    203 203 .param int readlineInd
    204 204

  • trunk/languages/tcl/tools/gen_inline.pl

     
    37 37
    38 38 # type subroutine
    39 39 bool => 'toBoolean',
    40 channel => '__channel',
    40 channel => 'getChannel',
    41 41 expr => 'compileExpr',
    42 42 int => 'toInteger',
    43 43 list => 'toList',