languages/tcl/runtime/builtin/rename.pir

   1 ###
   2 # [rename]
   3
   4 .HLL 'Tcl', 'tcl_group'
   5 .namespace []
   6
   7 .sub '&rename'
   8   .param pmc argv :slurpy
   9
  10   .local int argc
  11   argc = argv
  12   if argc != 2 goto bad_args
  13
  14   .local string oldName, newName
  15   oldName = argv[0]
  16   newName = argv[1]
  17
  18   # Change the epoch
  19   $P0 = get_root_global ['_tcl'], 'epoch'
  20   inc $P0
  21
  22   .local pmc sub, args, builtin, ns
  23
  24   $P1 = getinterp
  25   ns = $P1['namespace'; 1]
  26
  27   $S0 = '&' . oldName
  28   sub = ns[$S0]
  29   if null sub goto doesnt_exist
  30
  31   # if the newName is '', just delete the sub
  32   .local int delete_only
  33   delete_only = 0
  34   if newName != '' goto delete_sub
  35   delete_only = 1
  36
  37 delete_sub:
  38   delete ns[$S0]
  39
  40   if delete_only goto delete_builtin
  41
  42 add_sub:
  43   # Create the new sub
  44   $S0 = '&' . newName
  45   # first check to make sure it doesn't already exist
  46   $P0 = ns[$S0]
  47   if null $P0 goto set_new_sub
  48
  49   $S0 = "can't rename to \""
  50   $S0 .= newName
  51   $S0 .= '": command already exists'
  52   tcl_error $S0
  53
  54 set_new_sub:
  55   ns[$S0] = sub
  56
  57 delete_builtin:
  58   builtin = get_root_global ['_tcl'; 'builtins'], oldName
  59   if null builtin goto return
  60
  61   $P0 = get_root_namespace ['_tcl'; 'builtins']
  62   delete $P0[oldName]
  63
  64   if delete_only goto return
  65
  66 add_builtin:
  67   set_root_global ['_tcl'; 'builtins'], newName, builtin
  68
  69 return:
  70   .return('')
  71
  72 doesnt_exist:
  73   if newName == '' goto cant_delete
  74
  75   $S0 = "can't rename \""
  76   $S0 .= oldName
  77   $S0 .= "\": command doesn't exist"
  78   tcl_error $S0
  79
  80 cant_delete:
  81   $S0 = "can't delete \""
  82   $S0 .= oldName
  83   $S0 .= "\": command doesn't exist"
  84   tcl_error $S0
  85
  86 bad_args:
  87   tcl_error 'wrong # args: should be "rename oldName newName"'
  88 .end
  89
  90 # Local Variables:
  91 #   mode: pir
  92 #   fill-column: 100
  93 # End:
  94 # vim: expandtab shiftwidth=4 ft=pir: