languages/tcl/runtime/builtin/lsearch.pir

   1 .HLL 'Tcl', ''
   2 .namespace []
   3
   4 .sub '&lsearch'
   5   .param pmc argv :slurpy
   6
   7   .local pmc options
   8   options = get_root_global ['_tcl'; 'helpers'; 'lsearch'], 'options'
   9
  10   .local pmc select_switches, switches
  11   select_switches  = get_root_global ['_tcl'], 'select_switches'
  12   switches = select_switches(options, argv, 0, 1, 'option')
  13
  14   .local int argc
  15   argc = elements argv
  16
  17   if argc != 2 goto bad_args
  18
  19   .local string option, pattern
  20   .local pmc list, toList
  21
  22   toList = get_root_global [ '_tcl' ] , 'toList'
  23   list    = shift argv
  24   list = toList(list)
  25   pattern = shift argv
  26
  27   .local pmc iter
  28   iter = new 'Iterator', list
  29
  30   .local int pos, result
  31   result = -1
  32   pos = 0
  33
  34   .local int lc
  35   lc = exists switches['nocase']
  36   unless lc goto got_case
  37   pattern = downcase pattern
  38
  39 got_case:
  40   $I1 = exists switches['exact']
  41   if $I1 goto exact_loop
  42   $I1 = exists switches['regexp']
  43   if $I1 goto regexp_begin
  44
  45 glob_begin:
  46   .local pmc globber
  47   globber = compreg 'Tcl::Glob'
  48   .local pmc rule, match
  49   rule = globber.'compile'(pattern)
  50
  51 glob_loop:
  52   unless iter goto done
  53   $S0 = shift iter
  54   unless lc goto glob_match
  55   $S0 = downcase $S0
  56 glob_match:
  57   match = rule($S0)
  58   unless match goto glob_next
  59   result = pos
  60   goto done
  61 glob_next:
  62   inc pos
  63   goto glob_loop
  64
  65 regexp_begin: # very similar to glob_...
  66   .local pmc regexp
  67   regexp = compreg 'PGE::P5Regex'
  68   .local pmc rule, match
  69   rule = regexp(pattern)
  70
  71 regexp_loop:
  72   unless iter goto done
  73   $S0 = shift iter
  74   unless lc goto regexp_match
  75   $S0 = downcase $S0
  76 regexp_match:
  77   match = rule($S0)
  78   unless match goto regexp_next
  79   result = pos
  80   goto done
  81 regexp_next:
  82   inc pos
  83   goto regexp_loop
  84
  85 exact_loop:
  86   unless iter goto done
  87   $S0 = shift iter
  88   unless lc goto exact_match
  89   $S0 = downcase $S0
  90 exact_match:
  91   if $S0 != pattern goto exact_next
  92   result = pos
  93   goto done
  94 exact_next:
  95   inc pos
  96   goto exact_loop
  97
  98 done:
  99   .return (result)
 100
 101 bad_args:
 102   die 'wrong # args: should be "lsearch ?options? list pattern"'
 103 .end
 104
 105 .sub 'anon' :anon :load
 106   .local pmc options
 107   options = new 'TclList'
 108   push options, 'all'
 109   push options, 'ascii'
 110   push options, 'decreasing'
 111   push options, 'dictionary'
 112   push options, 'exact'
 113   push options, 'glob'
 114   push options, 'increasing'
 115   push options, 'index'
 116   push options, 'inline'
 117   push options, 'integer'
 118   push options, 'nocase'
 119   push options, 'not'
 120   push options, 'real'
 121   push options, 'regexp'
 122   push options, 'sorted'
 123   push options, 'start'
 124   push options, 'subindices'
 125
 126   set_root_global ['_tcl'; 'helpers'; 'lsearch'], 'options', options
 127 .end
 128
 129
 130 # Local Variables:
 131 #   mode: pir
 132 #   fill-column: 100
 133 # End:
 134 # vim: expandtab shiftwidth=4 ft=pir: