languages/cardinal/src/classes/Hash.pir

   1 ## $Id$
   2
   3 =head1 NAME
   4
   5 src/classes/CardinalHash.pir - Cardinal hash class and related functions
   6
   7 =head1 Methods
   8
   9 =over 4
  10
  11 =cut
  12
  13 .namespace ['CardinalHash']
  14
  15 .sub 'onload' :anon :load :init
  16     .local pmc cardinalmeta, mappingproto
  17     cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
  18     mappingproto = cardinalmeta.'new_class'('CardinalHash', 'parent'=>'Hash CardinalObject')
  19     cardinalmeta.'register'('Hash', 'parent'=>'CardinalObject', 'protoobject'=>mappingproto)
  20     $P0 = get_class 'CardinalHash'
  21     addattribute $P0, 'default'
  22 .end
  23
  24
  25 .sub 'get_string' :vtable :method
  26     $S0 = '{'
  27     .local pmc iter
  28     iter = new 'Iterator', self
  29     goto loop_start
  30   loop:
  31     unless iter goto end
  32     $S0 = concat $S0, ','
  33   loop_start:
  34     $S1 = shift iter
  35     $S2 = iter[$S1]
  36     $S0 = concat $S0, $S1
  37     $S0 = concat $S0, '=>'
  38     concat $S0, $S2
  39     goto loop
  40   end:
  41     concat $S0, '}'
  42     .return ($S0)
  43 .end
  44
  45 =item to_s (method)
  46
  47 Returns a string of keys and values appended together.
  48
  49 =cut
  50
  51 .sub 'to_s' :method
  52     .local pmc iter
  53     .local pmc rv
  54     iter = new 'Iterator', self
  55     rv   = new 'CardinalString'
  56   loop:
  57     unless iter goto end
  58     $S1 = shift iter
  59     concat rv, $S1
  60     $S1 = iter[$S1]
  61     concat rv, $S1
  62     goto loop
  63   end:
  64     .return (rv)
  65 .end
  66
  67
  68
  69 =item kv (method)
  70
  71 Returns elements of hash as array of C<Pair(key, value)>
  72
  73 =cut
  74
  75 .sub 'kv' :method
  76     .local pmc iter
  77     .local pmc rv
  78     iter = new 'Iterator', self
  79     rv   = new 'List'
  80   loop:
  81     unless iter goto end
  82     $S1 = shift iter
  83     push rv, $S1
  84     $S1 = iter[$S1]
  85     push rv, $S1
  86     goto loop
  87   end:
  88     .return (rv)
  89 .end
  90
  91
  92
  93 .sub 'keys' :method
  94     .local pmc iter
  95     .local pmc rv
  96     iter = new 'Iterator', self
  97     rv   = new 'List'
  98   loop:
  99     unless iter goto end
 100     $S1 = shift iter
 101     push rv, $S1
 102     goto loop
 103   end:
 104     .return (rv)
 105 .end
 106
 107
 108 .sub 'values' :method
 109     .local pmc iter
 110     .local pmc rv
 111     iter = new 'Iterator', self
 112     rv   = new 'List'
 113   loop:
 114     unless iter goto end
 115     $S1 = shift iter
 116     $S1 = iter[$S1]
 117     push rv, $S1
 118     goto loop
 119   end:
 120     .return (rv)
 121 .end
 122
 123 =item each(block)
 124
 125 Run C<block> once for each item in C<self>, with the key and value passed as args.
 126
 127 =cut
 128
 129 .sub 'each' :method
 130     .param pmc block
 131     .local pmc iter
 132     iter = new 'Iterator', self
 133   each_loop:
 134     unless iter goto each_loop_end
 135     $P1 = shift iter
 136     $P2 = iter[$P1]
 137     block($P1,$P2)
 138     goto each_loop
 139   each_loop_end:
 140 .end
 141
 142
 143 ## FIXME:  Parrot currently requires us to write our own "clone" method.
 144 .sub 'clone' :vtable :method
 145     $P0 = new 'CardinalHash'
 146     .local pmc iter
 147     iter = new 'Iterator', self
 148   loop:
 149     unless iter goto end
 150     $P1 = shift iter
 151     $P2 = iter[$P1]
 152     $P0[$P1] = $P2
 153     goto loop
 154   end:
 155     .return ($P0)
 156 .end
 157
 158 .sub '[]' :method
 159     .param pmc i
 160     $P0 = self[i]
 161   unless_null $P0, index_return
 162     $P0 = getattribute self, 'default'
 163     .local string type
 164     type = typeof $P0
 165     $I0 = iseq type, 'Closure'
 166     unless $I0 goto index_return
 167     $P1 = $P0(self,i)
 168     $P0 = $P1
 169   index_return:
 170     .return($P0)
 171 .end
 172
 173 .sub '[]=' :method
 174     .param pmc k
 175     .param pmc v
 176     self[k] = v
 177     .return(v)
 178 .end
 179
 180 =back
 181
 182 =head1 Functions
 183
 184 =over 4
 185
 186 =back
 187
 188 =head1 TODO: Functions
 189
 190 =over 4
 191
 192 =cut
 193
 194 .namespace []
 195
 196 =item delete
 197
 198  our List  multi method Hash::delete ( *@keys )
 199  our Scalar multi method Hash::delete ( $key ) is default
 200
 201 Deletes the elements specified by C<$key> or C<$keys> from the invocant.
 202 returns the value(s) that were associated to those keys.
 203
 204 =item exists
 205
 206  our Bool multi method Hash::exists ( $key )
 207
 208 True if invocant has an element whose key matches C<$key>, false
 209 otherwise.
 210
 211 =item keys
 212
 213 =item kv
 214
 215 =cut
 216
 217 .sub kv :multi('Hash')
 218     .param pmc hash
 219
 220     .return hash.'kv'()
 221 .end
 222
 223
 224 =item pairs
 225
 226 =item values
 227
 228  multi Int|List Hash::keys ( %hash : MatchTest *@keytests )
 229  multi Int|List Hash::kv ( %hash : MatchTest *@keytests )
 230  multi Int|(List of Pair) Hash::pairs  (%hash : MatchTest *@keytests )
 231  multi Int|List Hash::values ( %hash : MatchTest *@keytests )
 232
 233 Iterates the elements of C<%hash> in no apparent order, but the order
 234 will be the same between successive calls to these functions, as long as
 235 C<%hash> doesn't change.
 236
 237 If C<@keytests> are provided, only elements whose keys evaluate
 238 C<$key ~~ any(@keytests)> as true are iterated.
 239
 240 What is returned at each element of the iteration varies with function.
 241 C<keys> only returns the key; C<values> the value; C<kv> returns both as
 242 a 2 element list in (key, value) order, C<pairs> a C<Pair(key, value)>.
 243
 244 Note that C<kv %hash> returns the same as C<zip(keys %hash; values %hash)>
 245
 246 In Scalar context, they all return the count of elements that would have
 247 been iterated.
 248
 249 The lvalue form of C<keys> is not longer supported. Use the C<.buckets>
 250 property instead.
 251
 252 =back
 253
 254 =cut
 255
 256 .namespace []
 257
 258 .sub 'infix:=>'
 259     .param pmc key
 260     .param pmc value
 261     $P1 = new 'CardinalArray'
 262     $P1.'push'(key)
 263     $P1.'push'(value)
 264     .return($P1)
 265 .end
 266
 267 .sub 'hash'
 268     .param pmc pairs        :slurpy
 269     .local pmc ahash
 270     ahash = new 'CardinalHash'
 271     .local pmc item
 272   pairs_loop:
 273     unless pairs goto pairs_loop_end
 274     item = shift pairs
 275     $P0 = shift item
 276     $P1 = shift item
 277     ahash[$P0] = $P1
 278     goto pairs_loop
 279   pairs_loop_end:
 280     .return(ahash)
 281 .end
 282
 283 .namespace ['Hash']
 284
 285 .sub 'new' :method :multi(_)
 286     $P0 = new 'CardinalHash'
 287     .return($P0)
 288 .end
 289
 290 .sub 'new' :method :multi(_,_)
 291     .param pmc a
 292     $P0 = new 'CardinalHash'
 293     setattribute $P0, 'default', a
 294     .return($P0)
 295 .end
 296
 297 # Local Variables:
 298 #   mode: pir
 299 #   fill-column: 100
 300 # End:
 301 # vim: expandtab shiftwidth=4 ft=pir: