/pliant/language/type/set/old_dictionary.pli
 
 1  scope "/pliant/language/" "/pliant/install/" 
 2  module "/pliant/install/ring2.pli" 
 3   
 4   
 5  method d key_map key t default -> a 
 6    arg_rw Dictionary d ; arg Str key ; arg Type t ; arg Universal default ; arg Address a 
 7    var Pointer:Arrow :> first key 
 8    while true 
 9      if c=null 
 10        := entry_new t 
 11        insert key true a 
 12        if addressof:default<>null 
 13          copy_instance addressof:default a 
 14        return 
 15      if entry_type:c=t 
 16        return c 
 17      :> next key c 
 18       
 19  meta '. kmap' e 
 20    if e:size<or e:size>or not (e:cast Dictionary) or not (e:cast Str) or (e:constant Type)=null 
 21      return 
 22    var Pointer:Type :> (e:constant Type) map Type 
 23    suckup e:0 
 24    suckup e:1 
 25    var Link:Argument default 
 26    if e:size=3 
 27      default :> new Argument 
 28      default locate argument_constant 
 29      var Link:Expression :> expression immediat undefined near e 
 30      if (constant t)<>null 
 31        default constant := constant t 
 32      else 
 33        default constant := entry_new t 
 34    else 
 35      if not (e:cast t) 
 36        return 
 37      suckup e:3 
 38      default :> e:result 
 39    var Link:Argument :> argument indirect t (argument local Address) 0 
 40    add (instruction (the_function '. key_map' Dictionary Str Type Universal -> Address) e:0:result e:1:result (argument mapped_constant Type t) default a:pointer) 
 41    set_result access_read+(e:0:access .and. access_write)+access_object 
 42   
 43   
 44  method d exists key t -> defined 
 45    arg Dictionary d ; arg Str key ; arg Type t ; arg CBool defined 
 46    var Pointer:Arrow :> first key 
 47    while true 
 48      if c=null 
 49        return false 
 50      if entry_type:c=t 
 51        return true 
 52      :> next key c 
 53   
 54  export '. kmap' '. exists' 
 55   
 56   
 57  type Any 
 58    void 
 59     
 60  method d scan_forward t index n item -> some 
 61    arg Dictionary d ; arg Type t ; arg_rw Int index ; arg Address n ; arg_rw Pointer:Arrow item ; arg CBool some 
 62    var Address node := n 
 63    while true 
 64      if node=null 
 65        index += 1 
 66        if index>=d:hashsize 
 67          return false 
 68        else 
 69          node := ((addressof:map Address) translate Address index) map Address 
 70      else 
 71        item :> ((node translate Address 1) translate Str 1) map Arrow 
 72        if t<>Any and entry_type:item<>t 
 73          node := node map Address 
 74        else   
 75          return true 
 76    some := false 
 77     
 78  method d scan_first t index item -> some 
 79    arg Dictionary d ; arg Type t ; arg_rw Int index ; arg_rw Pointer:Arrow item ; arg CBool some 
 80    if d:hashsize=0 
 81      return false 
 82    index := 0 
 83    var Address node := (addressof:map Address) map Address 
 84    some := scan_forward index node item 
 85     
 86  method d scan_next t index item -> some 
 87    arg Dictionary d ; arg Type t ; arg_rw Int index ; arg_rw Pointer:Arrow item ; arg CBool some 
 88    var Address node := (addressof:item translate Str -1) translate Arrow -1 
 89    node := node map Address 
 90    some := scan_forward index node item 
 91     
 92  function dictionary_item_label item -> label 
 93    arg Pointer:Arrow item ; arg_R Str label 
 94    label :> (addressof:item translate Str -1) map Str 
 95     
 96  meta each e 
 97    if e:size<or not e:0:is_pure_ident or not (e:cast Dictionary) 
 98      return 
 99    var Pointer:Arrow :> pliant_general_dictionary first "pliant function" 
 100    if c=null or entry_type:c<>Function 
 101      return 
 102    var Link:Function current_function :> map Function 
 103    var Link:Expression key :> null map Expression 
 104    var Link:Type :> Any 
 105    var Int := 2 
 106    while i<e:size-1 
 107      if i+1<e:size and e:i:ident="type" and (e:(i+1) constant Type)<>null 
 108        :> (e:(i+1) constant Type) map Type 
 109        += 2 
 110      eif i+1<e:size and e:i:ident="getkey" and e:(i+1):is_pure_ident 
 111        key :> i+1 
 112        += 2 
 113      else 
 114        return 
 115    var Link:Argument index :> argument local Int 
 116    var Link:Argument arrow :> argument local Pointer:Arrow 
 117    if t=Any 
 118      arrow :> argument local Pointer:Arrow 
 119    else 
 120      arrow :> argument local (pointerto linkto:t) 
 121    var Link:Argument some :> argument local CBool 
 122    var Link:LocalVariable lv :> new LocalVariable 
 123    lv name := e:ident 
 124    lv body :> arrow 
 125    lv access := access_read+access_write 
 126    lv function :> current_function 
 127    define lv:name addressof:lv e:module 
 128    suckup e:1 
 129    var Link:Instruction end :> instruction the_function:'do nothing' 
 130    add (instruction (the_function '. scan_first' Dictionary Type Int Pointer:Arrow -> CBool) e:1:result (argument mapped_constant Type t) index arrow some) 
 131    add (instruction (the_function 'jump if not' CBool) some jump end) 
 132    var Link:Instruction body :> instruction the_function:'do nothing' 
 133    add body 
 134    if addressof:key<>null 
 135      var Link:Argument label :> argument indirect Str (argument local Address) 0 
 136      var Link:LocalVariable lv :> new LocalVariable 
 137      lv name := key ident 
 138      lv body :> label 
 139      lv access := access_read 
 140      lv function :> current_function 
 141      define lv:name addressof:lv e:module 
 142      add (instruction (the_function dictionary_item_label Pointer:Arrow -> Str) arrow label) 
 143    (e:size-1) compile ? 
 144    suckup (e:size-1) 
 145    add (instruction (the_function '. scan_next' Dictionary Type Int Pointer:Arrow -> CBool) e:1:result (argument mapped_constant Type t) index arrow some) 
 146    add (instruction (the_function 'jump if' CBool) some jump body) 
 147    add end  
 148    set_void_result 
 149     
 150  export each