basis/hashtables/numbers/numbers.factor

   1 ! Copyright (C) 2013 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors assocs combinators hashtables
   5 hashtables.wrapped kernel math math.hashcodes parser
   6 vocabs.loader ;
   7
   8 IN: hashtables.numbers
   9
  10 <PRIVATE
  11
  12 TUPLE: number-wrapper
  13     { underlying number read-only } ;
  14
  15 C: <number-wrapper> number-wrapper
  16
  17 M: number-wrapper equal?
  18     over number-wrapper?
  19     [ [ underlying>> ] bi@ number= ]
  20     [ 2drop f ] if ; inline
  21
  22 M: number-wrapper hashcode*
  23     nip underlying>> number-hashcode ; inline
  24
  25 PRIVATE>
  26
  27 TUPLE: number-hashtable < wrapped-hashtable ;
  28
  29 : <number-hashtable> ( n -- shashtable )
  30     <hashtable> number-hashtable boa ; inline
  31
  32 M: number-hashtable wrap-key drop <number-wrapper> ;
  33
  34 M: number-hashtable clone
  35     underlying>> clone number-hashtable boa ; inline
  36
  37 : >number-hashtable ( assoc -- shashtable )
  38     [ assoc-size <number-hashtable> ] keep assoc-union! ;
  39
  40 M: number-hashtable new-assoc drop <number-hashtable> ;
  41
  42 SYNTAX: NH{ \ } [ >number-hashtable ] parse-literal ;
  43
  44 { "hashtables.numbers" "prettyprint" } "hashtables.numbers.prettyprint" require-when