/pliant/language/type/set/dictionary.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  scope "/pliant/language/" "/pliant/install/" 
 17  module "/pliant/install/ring2.pli" 
 18  submodule "common.pli" 
 19   
 20  doc 
 21    [Todo: use a better hashing function.] 
 22   
 23   
 24  function update_hash_key u adr size 
 25    arg_rw uInt u ; arg Address adr ; arg Int size 
 26    for (var Int offset) size-uInt:size step uInt:size 
 27      := .xor. ((adr translate Byte offset) map uInt) 
 28      := (.*. 2^11) .or. (2^(32-11)) 
 29    if size%uInt:size<>0 
 30      := .xor. ( ((adr translate uInt size\uInt:size) map uInt) .and. 2^(8*(size%uInt:size))-1 ) 
 31   
 32  function hash i -> u 
 33    arg Int i ; arg uInt u 
 34    := addressof:map uInt 
 35   
 36  function hash i -> u 
 37    arg uInt i ; arg uInt u 
 38    := i 
 39   
 40  function hash s -> u 
 41    arg Str s ; arg uInt u 
 42    := 0 
 43    update_hash_key s:characters s:len 
 44   
 45  export update_hash_key hash 
 46   
 47   
 48  function find_hash_function t -> f 
 49    arg Type t ; arg_RW Function f 
 50    var Pointer:Arrow :> pliant_general_dictionary first "hash" 
 51    while c<>null 
 52      if entry_type:c=Function 
 53        :> map Function 
 54        if f:nb_args_with_result=and (arg 0):type=and (arg 1):type=uInt 
 55          return 
 56      :> pliant_general_dictionary next "hash" c 
 57    :> null map Function 
 58   
 59   
 60 
 
 61   
 62   
 63  gvar Relation 'pliant dictionary types' 
 64  export 'pliant dictionary types' 
 65   
 66  function Dictionary key value -> t 
 67    arg Type key value ; arg_R Type t 
 68    has_no_side_effect 
 69   
 70    var Address adr := 'pliant dictionary types' query addressof:key addressof:value 
 71    if adr<>null 
 72      return (adr map Type) 
 73   
 74    var Pointer:Function :> find_hash_function key 
 75    if addressof:f=null and (key:flags .and. type_flag_scalar)<>0 
 76      runtime_compile Key key 
 77        function hash k -> u 
 78          arg Key k ; arg uInt u 
 79          u := 0 
 80          update_hash_key u addressof:k Key:size 
 81        export hash 
 82      var Pointer:Function :> find_hash_function key 
 83    if addressof:f=null 
 84      error error_id_compile "There is no hash function available for "+key:name 
 85      :> Void ; return 
 86   
 87    runtime_compile  Key key Value value  Dictionary (cast "(Dictionary "+key:name+" "+value:name+")" Ident)  DictionaryNode (cast "(DictionaryNode "+key:name+" "+value:name+")" Ident)  hash_key (cast "hash "+key:name+" "+value:name Ident)  hash_function f  nodiv false  real addressof:value=(addressof value:real_data_type) 
 88   
 89      function hash_key k -> u 
 90        arg Universal k ; arg uInt u 
 91        u := hash_function (addressof:k map Key) 
 92   
 93      type DictionaryNode 
 94        field Pointer:DictionaryNode next_node 
 95        field Key key 
 96        field Value value 
 97   
 98      type Dictionary 
 99        field Address table 
 100        field Int hashsize 
 101        if nodiv 
 102          field uInt mask 
 103        field Int count 
 104   
 105      function build  d 
 106        arg_w Dictionary d 
 107        d table := null 
 108        d hashsize := 0 
 109        if nodiv 
 110          d mask := 0 
 111        d count := 0 
 112   
 113      function destroy d 
 114        arg_w Dictionary d 
 115        for (var Int i) 0 d:hashsize-1 
 116          var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode 
 117          while addressof:n<>null 
 118            var Pointer:DictionaryNode n2 :> n next_node 
 119            DictionaryNode destroy_instance addressof:n 
 120            memory_free addressof:n 
 121            n :> n2 
 122        memory_free d:table 
 123   
 124      method d walk i v 
 125        arg Dictionary d ; arg Int i ; arg_w Pointer:Value v 
 126        var Int j := i 
 127        while true 
 128          if j=d:hashsize 
 129            if real 
 130              v :> null map Value 
 131            else 
 132              (addressof Pointer:Value v) map Address := null 
 133            return 
 134          var Pointer:DictionaryNode n :> (d:table translate Address j) map Pointer:DictionaryNode 
 135          if addressof:n<>null 
 136            if real 
 137              v :> n value 
 138            else 
 139              (addressof Pointer:Value v) map Address := addressof Value n:value 
 140            return 
 141          j := j+1 
 142   
 143      method d next v1 -> v2 
 144        arg Dictionary d ; arg_r Value v1 ; arg_C Value v2 
 145        var Pointer:DictionaryNode n1 :> ((addressof:v1 translate Value 1) translate DictionaryNode -1) map DictionaryNode 
 146        var Pointer:DictionaryNode n2 :> n1 next_node 
 147        if addressof:n2<>null 
 148          if real 
 149            v2 :> n2 value 
 150          else 
 151            (addressof Pointer:Value v2) map Address := addressof Value n2:value 
 152        else 
 153          d walk (hash_key n1:key)%(cast d:hashsize uInt)+1 v2 
 154   
 155      method d first -> v 
 156        arg Dictionary d  ; arg_C Value v 
 157        d walk 0 v 
 158   
 159      method d walk k start v 
 160        arg Dictionary d ; arg Key k ; arg DictionaryNode start ; arg_w Pointer:Value v 
 161        var Pointer:DictionaryNode n :> start 
 162        while addressof:n<>null 
 163          if n:key=k 
 164            if real 
 165              v :> n value 
 166            else 
 167              (addressof Pointer:Value v) map Address := addressof Value n:value 
 168            return 
 169          n :> n next_node 
 170        if real 
 171          v :> null map Value 
 172        else 
 173          (addressof Pointer:Value v) map Address := null 
 174   
 175      method d first k -> v 
 176        arg Dictionary d ; arg Key k ; arg_C Value v 
 177        if d:hashsize<>0 
 178          if nodiv 
 179            var Int i 
 180            if d:mask<>0 
 181              i := hash_key:k .and. d:mask 
 182            else 
 183              i := hash_key:k%(cast d:hashsize uInt) 
 184          else 
 185            var Int i := hash_key:k%(cast d:hashsize uInt) 
 186          var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode 
 187          d walk k n v 
 188        else 
 189          if real 
 190            v :> null map Value 
 191          else 
 192            (addressof Pointer:Value v) map Address := null 
 193         
 194      method d first k default -> v 
 195        arg_rw Dictionary d ; arg Key k ; arg Value default ; arg_C Value v 
 196        v :> d first k 
 197        if not exists:v 
 198          v :> default    
 199   
 200      method d next k v1 -> v2 
 201        arg Dictionary d ; arg Key k ; arg_r Value v1 ; arg_C Value v2 
 202        var Pointer:DictionaryNode n :> ((addressof:v1 translate Value 1) translate DictionaryNode -1) map DictionaryNode 
 203        d walk k n:next_node v2 
 204   
 205      method d exists k -> c 
 206        arg Dictionary d ; arg Key k ; arg CBool c 
 207        c := exists (d first k) 
 208         
 209      method d '' k -> v 
 210        arg Dictionary d ; arg Key k ; arg_C Value v 
 211        (addressof Pointer:Value v) map Address := addressof Value (d first k) 
 212        if (addressof Value v)=null 
 213          error error_id_missing "there is no such key in the Dictionary" 
 214   
 215      method d resize size 
 216        arg_rw Dictionary d ; arg Int size 
 217        var Address newtable := memory_zallocate size*Address:size addressof:d 
 218        for (var Int i) 0 d:hashsize-1 
 219          var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode 
 220          while addressof:n<>null 
 221            var Pointer:DictionaryNode n2 :> n next_node 
 222            var Int newi := (hash_key n:key)%(cast size uInt) 
 223            n next_node :> (newtable translate Address newi) map Pointer:DictionaryNode 
 224            (newtable translate Address newi) map Pointer:DictionaryNode :> n 
 225            n :> n2 
 226        memory_free d:table 
 227        d table := newtable 
 228        d hashsize := size 
 229        if nodiv 
 230          d mask := 0 
 231          for (var Int i) 0 30 
 232            if 2^i=d:hashsize 
 233              d mask := d:hashsize-1 
 234            if 2^i>=d:hashsize 
 235              return 
 236   
 237      method d insert k v -> v2 
 238        arg_rw Dictionary d ; arg Key k ; arg Value v ; arg_C Value v2 
 239        if d:count>=d:hashsize 
 240          d resize (max 2*d:count 16) 
 241        var Pointer:DictionaryNode n :> (memory_allocate DictionaryNode:size addressof:d) map DictionaryNode 
 242        DictionaryNode build_instance addressof:n 
 243        Key copy_instance (addressof Key k) (addressof Key n:key) 
 244        Value copy_instance (addressof Value v) (addressof Value n:value) 
 245        var Int i := hash_key:k%(cast d:hashsize uInt) 
 246        n next_node :> (d:table translate Address i) map Pointer:DictionaryNode 
 247        (d:table translate Address i) map Pointer:DictionaryNode :> n 
 248        if real 
 249          v2 :> n value 
 250        else 
 251          (addressof Pointer:Value v2) map Address := addressof Value n:value 
 252        d count := d:count+1 
 253   
 254      method d '' k default -> v 
 255        arg_rw Dictionary d ; arg Key k ; arg Value default ; arg_C Value v 
 256        v :> d first k 
 257        if not exists:v 
 258          v :> d insert k default         
 259   
 260      function '-=' d v 
 261        arg_rw Dictionary d ; arg_r Value v 
 262        if d:hashsize=0 
 263          return 
 264        var Pointer:DictionaryNode n :> ((addressof:v translate Value 1) translate DictionaryNode -1) map DictionaryNode 
 265        var Int i := (hash_key n:key)%(cast d:hashsize uInt) 
 266        var (Pointer Pointer:DictionaryNode) ptr :>> (d:table translate Address i) map Pointer:DictionaryNode 
 267        while addressof:ptr<>addressof:n 
 268          ptr :>> ptr next_node 
 269        ptr :> n next_node 
 270        DictionaryNode destroy_instance addressof:n 
 271        memory_free addressof:n 
 272        d count := d:count-1 
 273     
 274      method d remove v -> v2 
 275        arg_rw Dictionary d ; arg_r Value v ; arg_C Value v2 
 276        if real 
 277          v2 :> d next v 
 278        else 
 279          (addressof Pointer:Value v2) map Address := addressof Value (d next v) 
 280        d -= v 
 281   
 282      method d key v -> k 
 283        arg Dictionary d ; arg_r Value v ; arg_R Key k 
 284        k :> (((addressof:v translate Value 1) translate DictionaryNode -1) map DictionaryNode) key 
 285   
 286      method d size -> n 
 287        arg Dictionary d ; arg Int n 
 288        n := d count 
 289   
 290      function copy src dest 
 291        arg Dictionary src ; arg_w Dictionary dest 
 292        Dictionary destroy_instance addressof:dest 
 293        Dictionary build_instance addressof:dest 
 294        dest resize src:size 
 295        for (var Int i) 0 src:hashsize-1 
 296          var Pointer:DictionaryNode n :> (src:table translate Address i) map Pointer:DictionaryNode 
 297          while addressof:n<>null 
 298            dest insert n:key n:value 
 299            n :> n next_node 
 300   
 301      method d check 
 302        arg Dictionary d 
 303        if pliant_debugging_level>=2 
 304          for (var Int i) 0 d:hashsize-1 
 305            var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode 
 306            while addressof:n<>null 
 307              check (hash_key n:key)%(cast d:hashsize uInt)=i 
 308              n :> n next_node 
 309   
 310      export Dictionary '' '. exists' '. first' '. next' '. key' '. insert' '. remove' '. resize' '-=' '. size' '. check' 
 311      'pliant dictionary types' define addressof:Key addressof:Value addressof:Dictionary 
 312      'pliant set types' define addressof:Dictionary addressof:Dictionary addressof:(new Str "Dictionary") 
 313      'pliant set types' define addressof:Dictionary null addressof:Key 
 314      'pliant set types' define null addressof:Dictionary addressof:Value 
 315   
 316    var Address adr := 'pliant dictionary types' query addressof:key addressof:value 
 317    check adr<>null 
 318    return (adr map Type) 
 319   
 320  export Dictionary 
 321