<commit_before>=head1 tcllib

This file contains all the PIR necessary to setup the basic C<Tcl>,
C<_Tcl>, and C<_TclWord> namespaces. These namespaces can then be used
by our own C<tcl.pir> to setup a tclsh-like interpreter, or to allow
other PIR programs to access procedures in our own namespaces, also
providing a compreg-compatible method.

=cut

# XXX It would be nice to be able to reduce the # of times we call
# .HLL here and in the .included files to a minimum.

.HLL 'parrot', ''

.loadlib 'tcl_ops'
.include 'languages/tcl/src/macros.pir'
.include 'cclass.pasm'

.namespace [ 'TclExpr::PAST::Grammar' ]
.include 'languages/tcl/src/grammar/expr/pge2past.pir'

.namespace [ 'TclExpr::PIR::Grammar' ]
.include 'languages/tcl/src/grammar/expr/past2pir.pir'

.include 'languages/tcl/src/grammar/expr/past.pir'

# all the builtin commands (HLL: Tcl - loads 'tcl_group')
.include 'languages/tcl/runtime/builtins.pir'

# library files (HLL: _Tcl)
.include 'languages/tcl/runtime/conversions.pir'
.include 'languages/tcl/runtime/list_to_string.pir'
.include 'languages/tcl/runtime/string_to_list.pir'
.include 'languages/tcl/runtime/variables.pir'
.include 'languages/tcl/src/compiler.pir'
.include 'languages/tcl/src/parser.pir'

# class files (HLL: _Tcl)
.include 'languages/tcl/src/class/tclcommand.pir'
.include 'languages/tcl/src/class/tclcommandlist.pir'
.include 'languages/tcl/src/class/tclconst.pir'
.include 'languages/tcl/src/class/tclvar.pir'
.include 'languages/tcl/src/class/tclword.pir'

# create the 'tcl' namespace -- see RT #39852
# http://rt.perl.org/rt3/Ticket/Display.html?id=39852
.HLL 'Tcl', ''
.namespace ['tcl']
.sub foo
  .return()
.end

.HLL '_Tcl', ''
.namespace

.sub __load_macros :load :anon
  $P0 = compreg 'PIR'
  $P0 = $P0(".sub main\n.include 'languages/tcl/src/macros.pir'\n.end")
  $P0()
.end

.sub __prepare_lib :load :anon

  # Load any dependant libraries.
  load_bytecode 'Getopt/Obj.pbc'
  load_bytecode 'PGE.pbc'
  load_bytecode 'PGE/Glob.pbc'
  load_bytecode 'PGE/Text.pbc'                                                                                                                                  
  load_bytecode 'PGE/Util.pbc'
  load_bytecode 'TGE.pbc'

  # Expose Environment variables.
  .local pmc env,tcl_env,iterator
  env = new .Env
  tcl_env = new .TclArray
  
  iterator = new .Iterator, env
  iterator = 0

  .local string key,value
env_loop:
  unless iterator goto env_loop_done
  key = shift iterator
  value = env[key]
  tcl_env[key] = value

  goto env_loop

env_loop_done:
  set_root_global ['tcl'], '$env', tcl_env

  # Set tcl_library: #XXX actually put a value here.
  $P1 = new 'TclString'
  $P1 = ''
  set_root_global ['tcl'], '$tcl_library', $P1

  # keep track of names of file types.
  .local pmc filetypes
  filetypes = new .TclArray
  filetypes[0o060000] = 'blockSpecial'
  filetypes[0o020000] = 'characterSpecial'
  filetypes[0o040000] = 'directory'
  filetypes[0o010000] = 'fifo'
  filetypes[0o100000] = 'file'
  filetypes[0o120000] = 'link'
  filetypes[0o140000] = 'socket'

   store_global 'filetypes', filetypes

   .local pmc binary_types
   binary_types = new .TclArray
   binary_types['a'] = 1
   binary_types['A'] = 1
   binary_types['b'] = 1
   binary_types['B'] = 1<commit_msg>[tcl] Populate $tcl_library with a real value based on parrot config.<commit_after>=head1 tcllib

This file contains all the PIR necessary to setup the basic C<Tcl>,
C<_Tcl>, and C<_TclWord> namespaces. These namespaces can then be used
by our own C<tcl.pir> to setup a tclsh-like interpreter, or to allow
other PIR programs to access procedures in our own namespaces, also
providing a compreg-compatible method.

=cut

# XXX It would be nice to be able to reduce the # of times we call
# .HLL here and in the .included files to a minimum.

.HLL 'parrot', ''

.loadlib 'tcl_ops'
.include 'languages/tcl/src/macros.pir'
.include 'cclass.pasm'

.namespace [ 'TclExpr::PAST::Grammar' ]
.include 'languages/tcl/src/grammar/expr/pge2past.pir'

.namespace [ 'TclExpr::PIR::Grammar' ]
.include 'languages/tcl/src/grammar/expr/past2pir.pir'

.include 'languages/tcl/src/grammar/expr/past.pir'

# all the builtin commands (HLL: Tcl - loads 'tcl_group')
.include 'languages/tcl/runtime/builtins.pir'

# library files (HLL: _Tcl)
.include 'languages/tcl/runtime/conversions.pir'
.include 'languages/tcl/runtime/list_to_string.pir'
.include 'languages/tcl/runtime/string_to_list.pir'
.include 'languages/tcl/runtime/variables.pir'
.include 'languages/tcl/src/compiler.pir'
.include 'languages/tcl/src/parser.pir'

# class files (HLL: _Tcl)
.include 'languages/tcl/src/class/tclcommand.pir'
.include 'languages/tcl/src/class/tclcommandlist.pir'
.include 'languages/tcl/src/class/tclconst.pir'
.include 'languages/tcl/src/class/tclvar.pir'
.include 'languages/tcl/src/class/tclword.pir'

# create the 'tcl' namespace -- see RT #39852
# http://rt.perl.org/rt3/Ticket/Display.html?id=39852
.HLL 'Tcl', ''
.namespace ['tcl']
.sub foo
  .return()
.end

.HLL '_Tcl', ''
.namespace

.sub __load_macros :load :anon
  $P0 = compreg 'PIR'
  $P0 = $P0(".sub main\n.include 'languages/tcl/src/macros.pir'\n.end")
  $P0()
.end

.sub __prepare_lib :load :anon

  # Load any dependant libraries.
  load_bytecode 'Getopt/Obj.pbc'
  load_bytecode 'PGE.pbc'
  load_bytecode 'PGE/Glob.pbc'
  load_bytecode 'PGE/Text.pbc'                                                                                                                                  
  load_bytecode 'PGE/Util.pbc'
  load_bytecode 'TGE.pbc'

  # Expose Environment variables.
  .local pmc env,tcl_env,iterator
  env = new .Env
  tcl_env = new .TclArray
  
  iterator = new .Iterator, env
  iterator = 0

  .local string key,value
env_loop:
  unless iterator goto env_loop_done
  key = shift iterator
  value = env[key]
  tcl_env[key] = value

  goto env_loop

env_loop_done:
  set_root_global ['tcl'], '$env', tcl_env

  # Set tcl_library:
  .local pmc interp
  interp = getinterp
  .include "iglobals.pasm"
  $P1 = interp[.IGLOBALS_CONFIG_HASH]
  $S0 = $P1['build_dir']
  $S1 = $P1['slash']
  $S0 .= $S1
  $S0 .= 'languages' 
  $S0 .= $S1
  $S0 .= 'tcl' 
  $S0 .= $S1
  $S0 .= 'library' 
  $P1 = new 'TclString'
  $P1 = $S0
  set_root_global ['tcl'], '$tcl_library', $P1

  # keep track of names of file types.
  .local pmc filetypes
  filetypes = new .TclArray
  filetypes[0o060000] = 'blockSpecial'
  filetypes[0o020000] = 'characterSpecial'
  filetypes[0o040000] = 'directory'
  filetypes[0o010000] = 'fifo'
  filetypes[0o100000] = 'file'
  filetypes[0o120000] = 'link'
  filetypes[0o140000] = 'socket'

   store_global 'filetypes', filetypes

   .local pmc binary_types
   binary_types = new .TclArray
   binary_types['a'] = 1
   binary_types['A'] = 1
   binary_types['b'] = 1
   binary_types['B'] = 1
{'fraction_non_alphanumeric': 0.1297003525264395, 'fraction_numerical': 0.024236192714453583, 'mean_word_length': 3.3507987220447286, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1663950', 'n_tokens_mistral': 2734, 'n_tokens_neox': 2576, 'n_words': 603}