basis/hashtables/numbers/numbers.factor

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