Revision 29712

Date:
2008/07/24 00:21:08
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/info.pir

     
    77 77 .local string procname
    78 78 procname = shift argv
    79 79
    80 .local pmc __namespace
    81 __namespace = get_root_global ['_tcl'], '__namespace'
    80 .local pmc splitNamespace
    81 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    82 82
    83 83 .local pmc ns
    84 84 .local string name
    85 ns = __namespace(procname)
    85 ns = splitNamespace(procname)
    86 86 name = pop ns
    87 87 name = '&' . name
    88 88
    … …  
    116 116 .local string procname
    117 117 procname = argv[0]
    118 118
    119 .local pmc __namespace
    120 __namespace = get_root_global ['_tcl'], '__namespace'
    119 .local pmc splitNamespace
    120 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    121 121
    122 122 .local pmc ns
    123 123 .local string name
    124 ns = __namespace(procname)
    124 ns = splitNamespace(procname)
    125 125 name = pop ns
    126 126 name = '&' . name
    127 127
    … …  
    186 186 .local pmc setVar
    187 187 setVar = get_root_global ['_tcl'], 'setVar'
    188 188
    189 .local pmc __namespace
    190 __namespace = get_root_global ['_tcl'], '__namespace'
    189 .local pmc splitNamespace
    190 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    191 191
    192 192 .local pmc ns
    193 193 .local string name
    194 ns = __namespace(procname)
    194 ns = splitNamespace(procname)
    195 195 name = pop ns
    196 196 name = '&' . name
    197 197

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

     
    76 76 argc = argv
    77 77 if argc goto bad_args
    78 78
    79 .local pmc ns, __namespace
    80 __namespace = get_root_global ['_tcl'], '__namespace'
    81 ns = __namespace('')
    79 .local pmc ns, splitNamespace
    80 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    81 ns = splitNamespace('')
    82 82 $S0 = join '::', ns
    83 83 $S0 = '::' . $S0
    84 84 .return($S0)
    … …  
    95 95 # no arg delete does nothing
    96 96 if argc == 0 goto return
    97 97
    98 .local pmc __namespace, ns_root
    99 __namespace = get_root_global ['_tcl'], '__namespace'
    98 .local pmc splitNamespace, ns_root
    99 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    100 100 ns_root = get_root_namespace ['tcl']
    101 101
    102 102 $I0 = 0
    103 103 delete_loop:
    104 104 if $I0 == argc goto return
    105 105 $S0 = argv[$I0]
    106 $P0 = __namespace($S0)
    106 $P0 = splitNamespace($S0)
    107 107 $I1 = 0
    108 108 $I2 = elements $P0
    109 109 dec $I2
    … …  
    245 245 unshift $P0, 'namespace'
    246 246 unshift info_level, $P0
    247 247
    248 .local pmc ns, __namespace
    249 __namespace = get_root_global ['_tcl'], '__namespace'
    248 .local pmc ns, splitNamespace
    249 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    250 250
    251 251 ns = shift argv
    252 ns = __namespace(ns, 1)
    252 ns = splitNamespace(ns, 1)
    253 253
    254 254 .local string namespace
    255 255 namespace = ''
    … …  
    322 322 .local pmc list
    323 323 list = new 'TclList'
    324 324
    325 .local pmc __namespace, ns, ns_name
    325 .local pmc splitNamespace, ns, ns_name
    326 326 .local string name
    327 __namespace = get_root_global ['_tcl'], '__namespace'
    327 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    328 328 name = ''
    329 329 if argc == 0 goto getname
    330 330
    331 331 name = argv[0]
    332 332 getname:
    333 ns_name = __namespace(name, 1)
    333 ns_name = splitNamespace(name, 1)
    334 334
    335 335 unshift ns_name, 'tcl'
    336 336 ns = get_root_namespace ns_name
    … …  
    450 450 name = argv[0]
    451 451
    452 452 get_parent:
    453 .local pmc ns, __namespace
    454 __namespace = get_root_global ['_tcl'], '__namespace'
    455 ns = __namespace(name)
    453 .local pmc ns, splitNamespace
    454 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    455 ns = splitNamespace(name)
    456 456 if $S0 != '' goto no_pop
    457 457 # for when someone calls [namespace current] from ::
    458 458 push_eh current_in_root

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

     
    21 21 args = argv[1]
    22 22 body = argv[2]
    23 23
    24 .local pmc pir_compiler, compileTcl, toList, __namespace
    24 .local pmc pir_compiler, compileTcl, toList, splitNamespace
    25 25 pir_compiler = compreg 'PIR'
    26 26 compileTcl = get_root_global ['_tcl'], 'compileTcl'
    27 27 toList = get_root_global ['_tcl'], 'toList'
    28 __namespace = get_root_global ['_tcl'], '__namespace'
    28 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    29 29
    30 30 .local pmc code, args_code, defaults
    31 31 .local string namespace
    … …  
    41 41
    42 42 if full_name == '' goto create
    43 43
    44 ns = __namespace(full_name, 1)
    44 ns = splitNamespace(full_name, 1)
    45 45 $I0 = elements ns
    46 46 if $I0 == 0 goto create
    47 47 name = pop ns

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

     
    35 35 astgrammar = new 'TclExpr::PAST::Grammar'
    36 36 pirgrammar = new 'TclExpr::PIR::Grammar'
    37 37
    38 .local pmc __namespace, ns
    38 .local pmc splitNamespace, ns
    39 39 .local string namespace
    40 __namespace = get_root_global ['_tcl'], '__namespace'
    41 ns = __namespace('', 2)
    40 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    41 ns = splitNamespace('', 2)
    42 42 namespace = ''
    43 43 $I0 = elements ns
    44 44 if $I0 == 0 goto loop

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

     
    87 87
    88 88 .local pmc ns
    89 89 .local string name
    90 ns = __namespace(new_var, 1)
    90 ns = splitNamespace(new_var, 1)
    91 91 name = pop ns
    92 92 name = '$' . name
    93 93

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

     
    11 11 argc = elements argv
    12 12 if argc == 0 goto bad_args
    13 13
    14 .local pmc findVar, storeVar, __namespace
    14 .local pmc findVar, storeVar, splitNamespace
    15 15 findVar = get_root_global ['_tcl'], 'findVar'
    16 16 storeVar = get_root_global ['_tcl'], 'storeVar'
    17 __namespace = get_root_global ['_tcl'], '__namespace'
    17 splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
    18 18
    19 19 .local pmc iter, name, value, ns
    20 20 iter = new 'Iterator', argv
    … …  
    37 37 unless iter goto no_value
    38 38 value = shift iter
    39 39
    40 ns = __namespace(name)
    40 ns = splitNamespace(name)
    41 41 $S0 = ns[-1]
    42 42 # store as a lexical *and* a global
    43 43 storeVar($S0, value)
    … …  
    45 45 goto loop
    46 46
    47 47 no_value:
    48 ns = __namespace(name)
    48 ns = splitNamespace(name)
    49 49 $S0 = ns[-1]
    50 50 # if the variable exists, just insert it as a lexical
    51 51 # otherwise, create a new Undef and insert it as both lexical and global

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

     
    475 475 tcl_error $S0
    476 476 .end
    477 477
    478 =head2 _Tcl::__namespace
    478 =head2 _Tcl::splitNamespace
    479 479
    480 480 Given a string namespace, return an array of names.
    481 481
    482 482 =cut
    483 483
    484 .sub __namespace
    484 .sub splitNamespace
    485 485 .param string name
    486 486 .param int depth :optional
    487 487 .param int has_depth :opt_flag

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

     
    63 63 error .= ' "'
    64 64 error .= choice
    65 65 error .= '": must be '
    66 $S1 = __options_to_string(options)
    66 $S1 = optionsToString(options)
    67 67 error .= $S1
    68 68 tcl_error error
    69 69
    … …  
    73 73 error .= ' "'
    74 74 error .= choice
    75 75 error .= '": must be '
    76 # $S1 = __options_to_string(partials) # Now, I like this better...
    77 $S1 = __options_to_string(options)
    76 $S1 = optionsToString(options)
    78 77 error .= $S1
    79 78 tcl_error error
    80 79 .end
    … …  
    187 186 $S1 .= ' "-'
    188 187 $S1 .= arg
    189 188 $S1 .= '": must be '
    190 $S2 = __switches_to_string(switches)
    189 $S2 = switchesToString(switches)
    191 190 $S1 .= $S2
    192 191 tcl_error $S1
    193 192 loop_next:
    … …  
    204 203 .return (results)
    205 204 .end
    206 205
    207 .sub __options_to_string
    206 .sub optionsToString
    208 207 .param pmc options
    209 208
    210 209 # uncomment this if folks start passing in un-ordered lists...
    … …  
    240 239 .return (error)
    241 240 .end
    242 241
    243 # Similar to __option_to_string. Refactor??
    244 .sub __switches_to_string
    242 # Similar to optionsToString. Refactor??
    243 .sub switchesToString
    245 244 .param pmc switches
    246 245
    247 246 # uncomment this if folks start passing in un-ordered lists...

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

     
    307 307 absolute = 1
    308 308 global_var:
    309 309 depth += 2
    310 ns = __namespace(name, depth)
    310 ns = splitNamespace(name, depth)
    311 311 $S0 = pop ns
    312 312 $S0 = '$' . $S0
    313 313
    … …  
    393 393
    394 394 global_var:
    395 395 depth += 2
    396 ns = __namespace(name, depth)
    396 ns = splitNamespace(name, depth)
    397 397 name = pop ns
    398 398 name = '$' . name
    399 399