Author: coke Date: Wed Jul 23 16:28:17 2008 New Revision: 29710 Modified: trunk/languages/tcl/runtime/builtin/catch.pir trunk/languages/tcl/runtime/builtin/dict.pir trunk/languages/tcl/runtime/builtin/eval.pir trunk/languages/tcl/runtime/builtin/expr.pir trunk/languages/tcl/runtime/builtin/fileevent.pir trunk/languages/tcl/runtime/builtin/foreach.pir trunk/languages/tcl/runtime/builtin/if.pir trunk/languages/tcl/runtime/builtin/info.pir trunk/languages/tcl/runtime/builtin/namespace.pir trunk/languages/tcl/runtime/builtin/parray.pir trunk/languages/tcl/runtime/builtin/proc.pir trunk/languages/tcl/runtime/builtin/source.pir trunk/languages/tcl/runtime/builtin/switch.pir trunk/languages/tcl/runtime/builtin/uplevel.pir trunk/languages/tcl/runtime/conversions.pir trunk/languages/tcl/runtime/tcllib.pir trunk/languages/tcl/src/builtin/expr.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/catch.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/catch.pir (original) +++ trunk/languages/tcl/runtime/builtin/catch.pir Wed Jul 23 16:28:17 2008 @@ -16,15 +16,15 @@ $P0 = getinterp ns = $P0['namespace'; 1] - .local pmc __script - __script = get_root_global ['_tcl'], '__script' + .local pmc compileTcl + compileTcl = get_root_global ['_tcl'], 'compileTcl' if argc == 0 goto bad_args if argc > 3 goto bad_args code = argv[0] push_eh non_ok - $P2 = __script(code, 'ns' => ns) + $P2 = compileTcl(code, 'ns' => ns) code_retval = $P2() retval = .CONTROL_OK pop_eh Modified: trunk/languages/tcl/runtime/builtin/dict.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/dict.pir (original) +++ trunk/languages/tcl/runtime/builtin/dict.pir Wed Jul 23 16:28:17 2008 @@ -204,9 +204,9 @@ options[1] = 'script' options[2] = 'value' - .local pmc select_option, __script, toBoolean + .local pmc select_option, compileTcl, toBoolean select_option = get_root_global ['_tcl'], 'select_option' - __script = get_root_global ['_tcl'], '__script' + compileTcl = get_root_global ['_tcl'], 'compileTcl' toBoolean = get_root_global ['_tcl'], 'toBoolean' .local pmc option option = shift argv @@ -270,7 +270,7 @@ .local pmc retval retval = new 'TclDict' .local pmc body_proc - body_proc = __script(body) + body_proc = compileTcl(body) .local pmc check_key,check_value script_loop: @@ -321,7 +321,7 @@ .local pmc set, script set = get_root_global ['_tcl'], 'setVar' - script = get_root_global ['_tcl'], '__script' + script = get_root_global ['_tcl'], 'compileTcl' .local pmc varNames .local string keyVar, valueVar @@ -339,7 +339,7 @@ .local pmc body,code body = shift argv - code = __script(body) + code = compileTcl(body) .local pmc iterator iterator = new 'Iterator', dictionary @@ -903,7 +903,7 @@ done_key_loop: # run the body of the script. save the return vaalue. .local pmc retval - $P1 = __script(body) + $P1 = compileTcl(body) retval = $P1() # go through the varnames, setting the appropriate keys to those values. @@ -1028,7 +1028,7 @@ goto alias_keys done_alias: .local pmc retval - $P1 = __script(body) + $P1 = compileTcl(body) retval = $P1() iterator = new 'Iterator', dictionary Modified: trunk/languages/tcl/runtime/builtin/eval.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/eval.pir (original) +++ trunk/languages/tcl/runtime/builtin/eval.pir Wed Jul 23 16:28:17 2008 @@ -18,12 +18,12 @@ $P0 = getinterp ns = $P0['namespace'; 1] - .local pmc __script - __script = get_root_global ['_tcl'], '__script' + .local pmc compileTcl + compileTcl = get_root_global ['_tcl'], 'compileTcl' .local string code code = join ' ', argv - $P2 = __script(code, 'ns'=>ns) + $P2 = compileTcl(code, 'ns'=>ns) .return $P2() bad_args: Modified: trunk/languages/tcl/runtime/builtin/expr.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/expr.pir (original) +++ trunk/languages/tcl/runtime/builtin/expr.pir Wed Jul 23 16:28:17 2008 @@ -14,8 +14,8 @@ .local int argc .local int looper - .local pmc __expr - __expr = get_root_global ['_tcl'], '__expr' + .local pmc compileExpr + compileExpr = get_root_global ['_tcl'], 'compileExpr' expr = '' looper = 0 @@ -29,7 +29,7 @@ $P0 = getinterp ns = $P0['namespace'; 1] - $P1 = __expr(expr, 'ns'=>ns) + $P1 = compileExpr(expr, 'ns'=>ns) $P2 = $P1() .return ($P2) 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 16:28:17 2008 @@ -10,9 +10,9 @@ if argc < 2 goto badargs if argc > 3 goto badargs - .local pmc __channel, __script + .local pmc __channel, compileTcl __channel = get_root_global ['_tcl'], '__channel' - __script = get_root_global ['_tcl'], '__script' + compileTcl = get_root_global ['_tcl'], 'compileTcl' .local pmc channel, script .local string event @@ -32,7 +32,7 @@ .local pmc script script = args[2] - script = __script(script) + script = compileTcl(script) .local pmc events events = get_root_global ['_tcl'], 'events' Modified: trunk/languages/tcl/runtime/builtin/foreach.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/foreach.pir (original) +++ trunk/languages/tcl/runtime/builtin/foreach.pir Wed Jul 23 16:28:17 2008 @@ -17,16 +17,16 @@ $P0 = getinterp ns = $P0['namespace'; 1] - .local pmc toList, __script, setVar + .local pmc toList, compileTcl, setVar toList = get_root_global ['_tcl'], 'toList' - __script = get_root_global ['_tcl'], '__script' + compileTcl = get_root_global ['_tcl'], 'compileTcl' setVar = get_root_global ['_tcl'], 'setVar' .local pmc varLists, lists, command varLists = new 'TclList' lists = new 'TclList' command = pop argv - command = __script(command, 'ns'=>ns) + command = compileTcl(command, 'ns'=>ns) .local int iterations iterations = 0 Modified: trunk/languages/tcl/runtime/builtin/if.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/if.pir (original) +++ trunk/languages/tcl/runtime/builtin/if.pir Wed Jul 23 16:28:17 2008 @@ -10,8 +10,8 @@ .local int argc argc = elements argv - .local pmc __expr - __expr = get_root_global ['_tcl'], '__expr' + .local pmc compileExpr + compileExpr = get_root_global ['_tcl'], 'compileExpr' if argc == 0 goto no_args @@ -26,7 +26,7 @@ # convert to the expression to a Sub $S0 = argv[0] - $P0 = __expr($S0, 'ns'=>ns) + $P0 = compileExpr($S0, 'ns'=>ns) $I0 = 1 if $I0 == argc goto no_script @@ -61,7 +61,7 @@ # convert to the expression to a Sub $S0 = argv[$I0] - $P0 = __expr($S0) + $P0 = compileExpr($S0) inc $I0 if $I0 == argc goto no_script @@ -90,8 +90,8 @@ arg_end: # now we can do the actual evaluation - .local pmc __script, toBoolean - __script = get_root_global ['_tcl'], '__script' + .local pmc compileTcl, toBoolean + compileTcl = get_root_global ['_tcl'], 'compileTcl' toBoolean = get_root_global ['_tcl'], 'toBoolean' .local pmc cond @@ -104,7 +104,7 @@ $P1 = cond() $I1 = toBoolean($P1) unless $I1 goto next - $P0 = __script(code, 'ns'=>ns) + $P0 = compileTcl(code, 'ns'=>ns) .return $P0() next: @@ -129,7 +129,7 @@ else: inc $I0 code = argv[$I0] - $P0 = __script(code, 'ns'=>ns) + $P0 = compileTcl(code, 'ns'=>ns) .return $P0() extra_words_after_else: 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 16:28:17 2008 @@ -151,7 +151,7 @@ .local pmc body body = argv[0] push_eh nope - $P1 = __script(body) + $P1 = compileTcl(body) pop_eh .return(1) Modified: trunk/languages/tcl/runtime/builtin/namespace.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/namespace.pir (original) +++ trunk/languages/tcl/runtime/builtin/namespace.pir Wed Jul 23 16:28:17 2008 @@ -261,11 +261,11 @@ namespace .= "']" global_ns: - .local pmc __script, code - __script = get_root_global ['_tcl'], '__script' + .local pmc compileTcl, code + compileTcl = get_root_global ['_tcl'], 'compileTcl' code = new 'CodeString' $S0 = join ' ', argv - ($S0, $S1) = __script($S0, 'pir_only'=>1) + ($S0, $S1) = compileTcl($S0, 'pir_only'=>1) $I0 = code.unique() code.emit(<<'END_PIR', namespace, $S0, $I0, $S1) .HLL 'tcl', 'tcl_group' Modified: trunk/languages/tcl/runtime/builtin/parray.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/parray.pir (original) +++ trunk/languages/tcl/runtime/builtin/parray.pir Wed Jul 23 16:28:17 2008 @@ -26,7 +26,7 @@ $P99 = open $S0, '<' $S0 = $P99.'slurp'('') - script = get_root_global ['_tcl'], '__script' + script = get_root_global ['_tcl'], 'compileTcl' # compile to PIR and put the sub in place... $P1 = script($S0) Modified: trunk/languages/tcl/runtime/builtin/proc.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/proc.pir (original) +++ trunk/languages/tcl/runtime/builtin/proc.pir Wed Jul 23 16:28:17 2008 @@ -21,9 +21,9 @@ args = argv[1] body = argv[2] - .local pmc pir_compiler, __script, toList, __namespace + .local pmc pir_compiler, compileTcl, toList, __namespace pir_compiler = compreg 'PIR' - __script = get_root_global ['_tcl'], '__script' + compileTcl = get_root_global ['_tcl'], 'compileTcl' toList = get_root_global ['_tcl'], 'toList' __namespace = get_root_global ['_tcl'], '__namespace' @@ -204,7 +204,7 @@ # Save the parsed body. .local string parsed_body, body_reg - (parsed_body, body_reg) = __script(body, 'pir_only'=>1) + (parsed_body, body_reg) = compileTcl(body, 'pir_only'=>1) code .= parsed_body Modified: trunk/languages/tcl/runtime/builtin/source.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/source.pir (original) +++ trunk/languages/tcl/runtime/builtin/source.pir Wed Jul 23 16:28:17 2008 @@ -24,9 +24,9 @@ interp = getinterp ns = interp['namespace';1] - .local pmc __script, code - __script = get_root_global ['_tcl'], '__script' - code = __script ( file_contents, 'ns' => ns, 'bsnl' => 1) + .local pmc compileTcl, code + compileTcl = get_root_global ['_tcl'], 'compileTcl' + code = compileTcl ( file_contents, 'ns' => ns, 'bsnl' => 1) .return code() Modified: trunk/languages/tcl/runtime/builtin/switch.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/switch.pir (original) +++ trunk/languages/tcl/runtime/builtin/switch.pir Wed Jul 23 16:28:17 2008 @@ -142,9 +142,9 @@ code = shift body body_match: if code == '-' goto fallthrough - .local pmc __script - __script = get_root_global ['_tcl'], '__script' - $P1 = __script(code) + .local pmc compileTcl + compileTcl = get_root_global ['_tcl'], 'compileTcl' + $P1 = compileTcl(code) .return $P1() extra_pattern: 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 16:28:17 2008 @@ -14,8 +14,8 @@ argc = elements argv if argc == 0 goto bad_args - .local pmc __script, __call_level - __script = get_root_global ['_tcl'], '__script' + .local pmc compileTcl, __call_level + compileTcl = get_root_global ['_tcl'], 'compileTcl' __call_level = get_root_global ['_tcl'], '__call_level' # save the old call level @@ -56,7 +56,7 @@ # if we get an exception, we have to reset the environment .local pmc retval push_eh restore_and_rethrow - $P0 = __script($S0) + $P0 = compileTcl($S0) retval = $P0() pop_eh Modified: trunk/languages/tcl/runtime/conversions.pir ============================================================================== --- trunk/languages/tcl/runtime/conversions.pir (original) +++ trunk/languages/tcl/runtime/conversions.pir Wed Jul 23 16:28:17 2008 @@ -283,13 +283,13 @@ .end -=head2 _Tcl::__expr +=head2 _Tcl::compileExpr Given an expression, return a subroutine, or optionally, the raw PIR =cut -.sub __expr +.sub compileExpr .param string expression .param int pir_only :named('pir_only') :optional .param pmc ns :named('ns') :optional @@ -372,13 +372,13 @@ tcl_error "empty expression\nin expression \"\"" .end -=head2 _Tcl::__script +=head2 _Tcl::compileTcl Given a chunk of tcl code, return a subroutine. =cut -.sub __script +.sub compileTcl .param string code .param int pir_only :named('pir_only') :optional .param pmc ns :named('ns') :optional Modified: trunk/languages/tcl/runtime/tcllib.pir ============================================================================== --- trunk/languages/tcl/runtime/tcllib.pir (original) +++ trunk/languages/tcl/runtime/tcllib.pir Wed Jul 23 16:28:17 2008 @@ -242,7 +242,7 @@ set_hll_global 'colons', colons # register the TCL compiler. - $P1 = get_root_global ['_tcl'], '__script' + $P1 = get_root_global ['_tcl'], 'compileTcl' compreg 'TCL', $P1 # Setup a global to keep a unique id for compiled subs. Modified: trunk/languages/tcl/src/builtin/expr.pir ============================================================================== --- trunk/languages/tcl/src/builtin/expr.pir (original) +++ trunk/languages/tcl/src/builtin/expr.pir Wed Jul 23 16:28:17 2008 @@ -27,12 +27,12 @@ end: arg = join ' ', raw_args - .local pmc __expr - __expr = get_root_global ['_tcl'], '__expr' + .local pmc compileExpr + compileExpr = get_root_global ['_tcl'], 'compileExpr' # make sure errors happen at runtime push_eh exception - ($P0, $S0) = __expr(arg, 'pir_only'=>1) + ($P0, $S0) = compileExpr(arg, 'pir_only'=>1) pop_eh pir = new 'CodeString' pir .= $P0 Modified: trunk/languages/tcl/src/tclsh.pir ============================================================================== --- trunk/languages/tcl/src/tclsh.pir (original) +++ trunk/languages/tcl/src/tclsh.pir Wed Jul 23 16:28:17 2008 @@ -42,8 +42,8 @@ tcl_interactive = new 'Integer' store_global '$tcl_interactive', tcl_interactive - .local pmc __script - __script = get_root_global ['_tcl'], '__script' + .local pmc compileTcl + compileTcl = get_root_global ['_tcl'], 'compileTcl' .local pmc get_options get_options = new 'Getopt::Obj' @@ -87,14 +87,14 @@ $S0 = $P0 $S0 .= "\n" # add back in the newline the prompt chomped input_line .= $S0 - # could probably avoid calling __script 2x here... + # could probably avoid calling compileTcl 2x here... unless dump_only goto execute_line .local string _pir - _pir = __script(input_line, 'pir_only'=>1, 'bsnl'=>1) + _pir = compileTcl(input_line, 'pir_only'=>1, 'bsnl'=>1) say _pir execute_line: push_eh loop_error - $P2 = __script(input_line) + $P2 = compileTcl(input_line) retval = $P2() pop_eh # print out the result of the evaluation. @@ -137,14 +137,14 @@ .set_tcl_argv() unless dump_only goto run_file push_eh file_error - ($S0,$I0) = __script(contents, 'pir_only'=>1, 'bsnl'=>1, 'wrapper'=>1) + ($S0,$I0) = compileTcl(contents, 'pir_only'=>1, 'bsnl'=>1, 'wrapper'=>1) pop_eh print $S0 goto done run_file: push_eh file_error - $P2 = __script(contents, 'bsnl' => 1) + $P2 = compileTcl(contents, 'bsnl' => 1) $P2() pop_eh goto done @@ -161,14 +161,14 @@ .local string tcl_code tcl_code = opt['e'] if dump_only goto oneliner_dump - $P3 = __script(tcl_code) + $P3 = compileTcl(tcl_code) push_eh file_error $P3() pop_eh goto done oneliner_dump: - ($S0,$I0) = __script(tcl_code, 'pir_only'=>1, 'bsnl'=>1, 'wrapper'=>1) + ($S0,$I0) = compileTcl(tcl_code, 'pir_only'=>1, 'bsnl'=>1, 'wrapper'=>1) print $S0 done: @@ -219,15 +219,15 @@ $S0 = level varname .= $S0 - .local pmc __script - __script = get_root_global ['_tcl'], '__script' + .local pmc compileTcl + compileTcl = get_root_global ['_tcl'], 'compileTcl' # XXX Should trap the printed output here, and then display # it using the readilne prompt, like everything else. # XXX Should be testing this push_eh no_prompt $P0 = find_global varname - $P2 = __script($P0) + $P2 = compileTcl($P0) $P2() pop_eh 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 16:28:17 2008 @@ -38,10 +38,10 @@ # type subroutine bool => 'toBoolean', channel => '__channel', - expr => '__expr', + expr => 'compileExpr', int => 'toInteger', list => 'toList', - script => '__script', + script => 'compileTcl', var => 'readVar', );
