Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/type/set/dictionary.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

scope "/pliant/language/" "/pliant/install/"
module "/pliant/install/ring2.pli"
submodule "common.pli"

doc
  [Todo: use a better hashing function.]


function update_hash_key u adr size
  arg_rw uInt u ; arg Address adr ; arg Int size
  for (var Int offset) 0 size-uInt:size step uInt:size
    u := u .xor. ((adr translate Byte offset) map uInt)
    u := (u .*. 2^11) .or. (u \ 2^(32-11))
  if size%uInt:size<>0
    u := u .xor. ( ((adr translate uInt size\uInt:size) map uInt) .and. 2^(8*(size%uInt:size))-1 )

function hash s -> u
  arg Str s ; arg uInt u
  u := 0
  update_hash_key u s:characters s:len

export update_hash_key hash


function find_hash_function t -> f
  arg Type t ; arg_RW Function f
  var Pointer:Arrow c :> pliant_general_dictionary first "hash"
  while c<>null
    if entry_type:c=Function
      f :> c map Function
      if f:nb_args_with_result=2 and (f arg 0):type=t and (f arg 1):type=uInt
        return
    c :> pliant_general_dictionary next "hash" c
  f :> null map Function


#--------------------------------------------------------------------------


gvar Relation 'pliant dictionary types'
export 'pliant dictionary types'


function Dictionary key value -> t
  arg Type key value ; arg_R Type t
  has_no_side_effect

  var Address adr := 'pliant dictionary types' query addressof:key addressof:value
  if adr<>null
    return (adr map Type)

  var Pointer:Function f :> find_hash_function key
  if addressof:f=null and (key:flags .and. type_flag_scalar)<>0
    runtime_compile Key key
      function hash k -> u
        arg Key k ; arg uInt u
        u := 0
        update_hash_key u addressof:k Key:size
      export hash
    var Pointer:Function f :> find_hash_function key
  if addressof:f=null
    error error_id_compile "There is no hash function available for "+key:name
    t :> Void ; return

  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

    function hash_key k -> u
      arg Universal k ; arg uInt u
      u := hash_function (addressof:k map Key)

    type DictionaryNode
      field Pointer:DictionaryNode next_node
      field Key key
      field Value value

    type Dictionary
      field Address table
      field Int hashsize
      field Int count

    function build  d
      arg_w Dictionary d
      d table := null
      d hashsize := 0
      d count := 0

    function destroy d
      arg_w Dictionary d
      for (var Int i) 0 d:hashsize-1
        var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode
        while addressof:n<>null
          var Pointer:DictionaryNode n2 :> n next_node
          DictionaryNode destroy_instance addressof:n
          memory_free addressof:n
          n :> n2
      memory_free d:table

    method d walk i v
      arg Dictionary d ; arg Int i ; arg_w Pointer:Value v
      var Int j := i
      while true
        if j=d:hashsize
          # v :> null map Value
          (addressof Pointer:Value v) map Address := null
          return
        var Pointer:DictionaryNode n :> (d:table translate Address j) map Pointer:DictionaryNode
        if addressof:n<>null
          # v :> n value
          (addressof Pointer:Value v) map Address := addressof Value n:value
          return
        j := j+1

    method d next v1 -> v2
      arg Dictionary d ; arg_r Value v1 ; arg_C Value v2
      var Pointer:DictionaryNode n1 :> ((addressof:v1 translate Value 1) translate DictionaryNode -1) map DictionaryNode
      var Pointer:DictionaryNode n2 :> n1 next_node
      if addressof:n2<>null
        # v2 :> n2 value
        (addressof Pointer:Value v2) map Address := addressof Value n2:value
      else
        d walk (hash_key n1:key)%(cast d:hashsize uInt)+1 v2

    method d first -> v
      arg Dictionary d  ; arg_C Value v
      d walk 0 v

    method d walk k start v
      arg Dictionary d ; arg Key k ; arg DictionaryNode start ; arg_w Pointer:Value v
      var Pointer:DictionaryNode n :> start
      while addressof:n<>null
        if n:key=k
          # v :> n value
          (addressof Pointer:Value v) map Address := addressof Value n:value
          return
        n :> n next_node
      # v :> null map Value
      (addressof Pointer:Value v) map Address := null

    method d first k -> v
      arg Dictionary d ; arg Key k ; arg_C Value v
      if d:hashsize<>0
        var Int i := hash_key:k%(cast d:hashsize uInt)
        var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode
        d walk k n v
      else
        # v :> null map Value
        (addressof Pointer:Value v) map Address := null
      
    method d first k default -> v
      arg_rw Dictionary d ; arg Key k ; arg Value default ; arg_C Value v
      v :> d first k
      if not exists:v
        v :> default   

    method d next k v1 -> v2
      arg Dictionary d ; arg Key k ; arg_r Value v1 ; arg_C Value v2
      var Pointer:DictionaryNode n :> ((addressof:v1 translate Value 1) translate DictionaryNode -1) map DictionaryNode
      d walk k n:next_node v2

    method d exists k -> c
      arg Dictionary d ; arg Key k ; arg CBool c
      c := exists (d first k)
      
    method d '' k -> v
      arg Dictionary d ; arg Key k ; arg_C Value v
      (addressof Pointer:Value v) map Address := addressof Value (d first k)
      if (addressof Value v)=null
        error error_id_missing "there is no such key in the Dictionary"

    method d resize size
      arg_rw Dictionary d ; arg Int size
      var Address newtable := memory_zallocate size*Address:size addressof:d
      for (var Int i) 0 d:hashsize-1
        var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode
        while addressof:n<>null
          var Pointer:DictionaryNode n2 :> n next_node
          var Int newi := (hash_key n:key)%(cast size uInt)
          n next_node :> (newtable translate Address newi) map Pointer:DictionaryNode
          (newtable translate Address newi) map Pointer:DictionaryNode :> n
          n :> n2
      memory_free d:table
      d table := newtable
      d hashsize := size

    method d insert k v -> v2
      arg_rw Dictionary d ; arg Key k ; arg Value v ; arg_C Value v2
      if d:count>=d:hashsize
        d resize (max 2*d:count 16)
      var Pointer:DictionaryNode n :> (memory_allocate DictionaryNode:size addressof:d) map DictionaryNode
      DictionaryNode build_instance addressof:n
      Key copy_instance (addressof Key k) (addressof Key n:key)
      Value copy_instance (addressof Value v) (addressof Value n:value)
      var Int i := hash_key:k%(cast d:hashsize uInt)
      n next_node :> (d:table translate Address i) map Pointer:DictionaryNode
      (d:table translate Address i) map Pointer:DictionaryNode :> n
      # v2 :> n value
      (addressof Pointer:Value v2) map Address := addressof Value n:value
      d count := d:count+1

    method d '' k default -> v
      arg_rw Dictionary d ; arg Key k ; arg Value default ; arg_C Value v
      v :> d first k
      if not exists:v
        v :> d insert k default        

    function '-=' d v
      arg_rw Dictionary d ; arg_r Value v
      if d:hashsize=0
        return
      var Pointer:DictionaryNode n :> ((addressof:v translate Value 1) translate DictionaryNode -1) map DictionaryNode
      var Int i := (hash_key n:key)%(cast d:hashsize uInt)
      var (Pointer Pointer:DictionaryNode) ptr :>> (d:table translate Address i) map Pointer:DictionaryNode
      while addressof:ptr<>addressof:n
        ptr :>> ptr next_node
      ptr :> n next_node
     DictionaryNode destroy_instance addressof:n
     memory_free addressof:n
     d count := d:count-1
      DictionaryNode destroy_instance addressof:n
      memory_free addressof:n
      d count := d:count-1
  
    method d remove v -> v2
      arg_rw Dictionary d ; arg_r Value v ; arg_C Value v2
      # v2 :> d next v
      (addressof Pointer:Value v2) map Address := addressof Value (d next v)
      d -= v

    method d key v -> k
      arg Dictionary d ; arg_r Value v ; arg_R Key k
      k :> (((addressof:v translate Value 1) translate DictionaryNode -1) map DictionaryNode) key

    method d size -> n
      arg Dictionary d ; arg Int n
      n := d count

    function copy src dest
      arg Dictionary src ; arg_w Dictionary dest
      Dictionary destroy_instance addressof:dest
      Dictionary build_instance addressof:dest
      dest resize src:size
      for (var Int i) 0 src:hashsize-1
        var Pointer:DictionaryNode n :> (src:table translate Address i) map Pointer:DictionaryNode
        while addressof:n<>null
          dest insert n:key n:value
          n :> n next_node

    method d check
      arg Dictionary d
      if pliant_debugging_level>=2
        for (var Int i) 0 d:hashsize-1
          var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode
          while addressof:n<>null
            check (hash_key n:key)%(cast d:hashsize uInt)=i
            n :> n next_node

    export Dictionary '' '. exists' '. first' '. next' '. key' '. insert' '. remove' '. resize' '-=' '. size' '. check'
    'pliant dictionary types' define addressof:Key addressof:Value addressof:Dictionary
    'pliant set types' define addressof:Dictionary addressof:Dictionary addressof:(new Str "Dictionary")
    'pliant set types' define addressof:Dictionary null addressof:Key
    'pliant set types' define null addressof:Dictionary addressof:Value

  var Address adr := 'pliant dictionary types' query addressof:key addressof:value
  check adr<>null
  return (adr map Type)

export Dictionary