/pliant/language/type/set/index.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   
 21 
 
 22  #   data types 
 23   
 24   
 25  type IndexNode_ 
 26    field Pointer:IndexNode_ right left 
 27    field Pointer:IndexNode_ father 
 28    field Int nb <- 0 
 29     
 30   
 31  type Index_ 
 32    field Pointer:IndexNode_ root 
 33     
 34   
 35 
 
 36  #   IndexNode_ small computations 
 37   
 38   
 39  function build  index 
 40    arg_w Index_ index 
 41    index root :> null map IndexNode_ 
 42     
 43  function free node nodetype nodeisobj 
 44    arg_rw IndexNode_ node ; arg Type nodetype ; arg CBool nodeisobj 
 45    if addressof:node=null 
 46      return 
 47    free node:left nodetype nodeisobj 
 48    free node:right nodetype nodeisobj 
 49    if nodeisobj 
 50      entry_unlock addressof:node 
 51    else 
 52      nodetype destroy_instance addressof:node 
 53      memory_free addressof:node 
 54   
 55  method index reset nodetype nodeisobj 
 56    arg_w Index_ index ; arg Type nodetype ; arg CBool nodeisobj 
 57    free index:root nodetype nodeisobj 
 58    index root :> null map IndexNode_ 
 59     
 60   
 61  method n safe_nb -> nb 
 62    arg IndexNode_ n ; arg Int nb 
 63    if addressof:n<>null 
 64      nb := nb 
 65    else 
 66      nb := 0 
 67   
 68  method n biggest_son -> s 
 69    arg IndexNode_ n ; arg_C IndexNode_ s 
 70    :> shunt n:left:safe_nb>=n:right:safe_nb n:left n:right 
 71   
 72  method n adjust_count 
 73    arg_rw IndexNode_ n 
 74    nb := n:left:safe_nb+n:right:safe_nb+1 
 75   
 76   
 77  method n key -> k 
 78    arg IndexNode_ n ; arg_C Universal k 
 79    :> (addressof:translate IndexNode_ 1) map Universal 
 80   
 81   
 82  method n value offset -> cursor 
 83    arg IndexNode_ n ; arg Int offset ; arg Address cursor 
 84    cursor := addressof:translate Byte offset 
 85   
 86  meta '. value' e 
 87    if e:size=and (e:cast IndexNode_) 
 88      compile_as (expression immediat (n value offset) substitute n e:0) 
 89   
 90  method n zvalue offset -> cursor 
 91    arg IndexNode_ n ; arg Int offset ; arg Address cursor 
 92    if addressof:n<>null 
 93      cursor := addressof:translate Byte offset 
 94    else 
 95      cursor := null 
 96   
 97  meta '. zvalue' e 
 98    if e:size=and (e:cast IndexNode_) 
 99      compile_as (expression immediat (n zvalue offset) substitute n e:0) 
 100   
 101   
 102  method cursor node offset -> n 
 103    arg Address cursor ; arg Int offset ; arg_C IndexNode_ n 
 104    :> (cursor translate Byte -offset) map IndexNode_ 
 105   
 106  meta '. node' e 
 107    if e:size=and (e:cast Address) 
 108      compile_as (expression immediat (c node offset) substitute c e:0) 
 109   
 110   
 111  function compare u1 u2 cmp -> c 
 112    arg Universal u1 u2 ; arg Function cmp ; arg Int c 
 113    indirect 
 114   
 115  meta compare e 
 116    if e:size=and (e:cast Universal) and (e:cast Universal) 
 117      compile_as (expression immediat (compare u1 u2 cmp) substitute u1 e:0 substitute u2 e:1) 
 118   
 119   
 120 
 
 121  #   checking 
 122   
 123   
 124  method index check node cmp 
 125    arg Index_ index ; arg IndexNode_ node ; arg Function cmp 
 126    if addressof:node=null 
 127      return 
 128    if node:nb<>node:left:safe_nb+node:right:safe_nb+1 
 129      error error_id_corrupted "Incorrect index (counter)" 
 130    if (addressof node:left)<>null 
 131      if (compare node:left:key node:key)=compare_superior 
 132        error error_id_corrupted "Incorrect index (left order)" 
 133      if (addressof node:left:father)<>addressof:node 
 134        error error_id_corrupted "Incorrect index (left son)" 
 135    if (addressof node:right)<>null 
 136      if (compare node:right:key node:key)=compare_inferior 
 137        error error_id_corrupted "Incorrect index (right order)" 
 138      if (addressof node:right:father)<>addressof:node 
 139        error error_id_corrupted "Incorrect index (right son)" 
 140    index check node:left cmp 
 141    index check node:right cmp 
 142   
 143  method index check cmp 
 144    arg Index_ index ; arg Function cmp 
 145    if (addressof index:root)=null 
 146      return 
 147    if (addressof index:root:father)<>null 
 148      error error_id_corrupted "Incorrect index (root)" 
 149    index check index:root cmp 
 150   
 151   
 152 
 
 153  #   walking 
 154   
 155   
 156  method index first offset -> cursor 
 157    arg Index_ index ; arg Int offset ; arg Address cursor 
 158    var Pointer:IndexNode_ node :> index root 
 159    if addressof:node=null 
 160      return null 
 161    while (addressof node:left)<>null 
 162      node :> node left 
 163    cursor := node value 
 164   
 165   
 166  method index last offset -> cursor 
 167    arg Index_ index ; arg Int offset ; arg Address cursor 
 168    var Pointer:IndexNode_ node :> index root 
 169    if addressof:node=null 
 170      return null 
 171    while (addressof node:right)<>null 
 172      node :> node right 
 173    cursor := node value 
 174   
 175   
 176  method index next cursor offset -> cursor2 
 177    arg Index_ index ; arg Int offset ; arg Address cursor cursor2 ; arg Int offset 
 178    check cursor<>null 
 179    var Pointer:IndexNode_ node :> cursor node 
 180    var Pointer:IndexNode_ node2 
 181    if (addressof node:right)<>null 
 182      node2 :> node right 
 183      while (addressof node2:left)<>null 
 184        node2 :> node2 left 
 185    else 
 186      var Pointer:IndexNode_ cur :> node ; node2 :> node father 
 187      while addressof:node2<>null and (addressof node2:right)=addressof:cur 
 188        cur :> node2 ; node2 :> node2 father 
 189    cursor2 := node2 zvalue 
 190   
 191     
 192  method index previous cursor offset -> cursor2 
 193    arg Index_ index ; arg Address cursor cursor2 ; arg Int offset 
 194    check cursor<>null 
 195    var Pointer:IndexNode_ node :> cursor node 
 196    var Pointer:IndexNode_ node2 
 197    if (addressof node:left)<>null 
 198      node2 :> node left 
 199      while (addressof node2:right)<>null 
 200        node2 :> node2 right 
 201    else 
 202      var Pointer:IndexNode_ cur :> node ; node2 :> node father 
 203      while addressof:node2<>null and (addressof node2:left)=addressof:cur 
 204        cur :> node2 ; node2 :> node2 father 
 205    cursor2 := node2 zvalue 
 206     
 207   
 208 
 
 209  #   searching 
 210   
 211   
 212  method index first sample cmp offset -> cursor 
 213    arg Index_ index ; arg Address sample ; arg Function cmp ; arg Int offset ; arg Address cursor 
 214    var Pointer:IndexNode_ cur :> index root 
 215    while addressof:cur<>null 
 216      var Int := compare (sample map Universal) cur:key 
 217      if c=compare_superior 
 218        cur :> cur right 
 219      eif c=compare_inferior 
 220        cur :> cur left 
 221      else 
 222        var Pointer:IndexNode_ son :> cur left 
 223        while addressof:son<>null 
 224          if (compare (sample map Universal) son:key)=compare_equal 
 225            cur :> son ; son :> son left 
 226          else 
 227            son :> son right 
 228        cursor := cur value 
 229        return 
 230    cursor := null 
 231   
 232   
 233  method index next sample cursor cmp offset -> cursor2 
 234    arg Index_ index ; arg Address sample ; arg Function cmp ; arg Int offset ; arg Address cursor cursor2 
 235    check (compare (sample map Universal) cursor:node:key)=compare_equal 
 236    cursor2 := index next cursor offset 
 237    if cursor2<>null and (compare (sample map Universal) cursor2:node:key)<>compare_equal 
 238      cursor2 :=null 
 239   
 240   
 241  # search for the first greater or equal 
 242  method index from sample cmp offset -> cursor 
 243    arg Index_ index ; arg Address sample ; arg Function cmp ; arg Int offset ; arg Address cursor 
 244    var Pointer:IndexNode_ cur :> index root 
 245    while addressof:cur<>null 
 246      var Int := compare cur:key (sample map Universal) 
 247      if c=compare_inferior 
 248        cur :> cur right 
 249      else 
 250        var Pointer:IndexNode_ son :> cur left 
 251        while addressof:son<>null 
 252          if ((compare son:key (sample map Universal)) .and. compare_superior+compare_equal)<>0 
 253            cur :> son ; son :> son left 
 254          else 
 255            son :> son right 
 256        cursor := cur value 
 257        return 
 258    cursor := null 
 259   
 260   
 261  # search for the first greater 
 262  method index to sample cmp offset -> cursor 
 263    arg Index_ index ; arg Address sample ; arg Function cmp ; arg Int offset ; arg Address cursor 
 264    var Pointer:IndexNode_ cur :> index root 
 265    while addressof:cur<>null 
 266      var Int := compare cur:key (sample map Universal) 
 267      if c=compare_superior 
 268        cur :> cur left 
 269      else 
 270        var Pointer:IndexNode_ son :> cur right 
 271        while addressof:son<>null 
 272          if ((compare son:key (sample map Universal)) .and. compare_inferior+compare_equal)<>0 
 273            cur :> son ; son :> son right 
 274          else 
 275            son :> son left 
 276        cursor := cur value 
 277        cursor := index next cursor offset 
 278        return 
 279    cursor := null 
 280   
 281   
 282 
 
 283  #   inserting, moving, removing 
 284   
 285   
 286  method index twist fat cur son -> node 
 287    arg_rw Index_ index ; arg_rw IndexNode_ fat cur son ; arg_C IndexNode_ node 
 288    var Pointer:IndexNode_ grand :> fat father 
 289    if addressof:cur=(addressof fat:right) 
 290      if addressof:son=(addressof cur:right) 
 291        cur father :> grand 
 292        fat father :> cur 
 293        if (addressof cur:left)<>null 
 294          cur:left father :> fat 
 295        fat right :> cur left 
 296        cur left :> fat 
 297        if addressof:grand=null 
 298          index root :> cur 
 299        eif (addressof grand:left)=addressof:fat 
 300          grand left :> cur 
 301        else 
 302          grand right :> cur 
 303        fat adjust_count 
 304        cur adjust_count 
 305        node :> cur 
 306      else 
 307        son father :> grand 
 308        cur father :> son 
 309        fat father :> son 
 310        if (addressof son:left)<>null 
 311          son:left father :> fat 
 312        if (addressof son:right)<>null 
 313          son:right father :> cur 
 314        fat right :> son left 
 315        cur left :> son right 
 316        son left :> fat 
 317        son right :> cur 
 318        if addressof:grand=null 
 319          index root :> son 
 320        eif (addressof grand:left)=addressof:fat 
 321          grand left :> son 
 322        else  
 323          grand right :> son 
 324        fat adjust_count 
 325        cur adjust_count 
 326        son adjust_count 
 327        node :> son 
 328    else 
 329      if addressof:son=(addressof cur:left) 
 330        cur father :> grand 
 331        fat father :> cur 
 332        if (addressof cur:right)<>null 
 333          cur:right father :> fat 
 334        fat left :> cur right 
 335        cur right :> fat 
 336        if addressof:grand=null 
 337          index root :> cur 
 338        eif (addressof grand:left)=addressof:fat 
 339          grand left :> cur 
 340        else 
 341          grand right :> cur 
 342        fat adjust_count 
 343        cur adjust_count 
 344        node :> cur 
 345      else 
 346        son father :> grand 
 347        cur father :> son 
 348        fat father :> son 
 349        if (addressof son:left)<>null 
 350          son:left father :> cur 
 351        if (addressof son:right)<>null 
 352          son:right father :> fat 
 353        fat left :> son right 
 354        cur right :> son left 
 355        son left :> cur 
 356        son right :> fat 
 357        if addressof:grand=null 
 358          index root :> son 
 359        eif (addressof grand:left)=addressof:fat 
 360          grand left :> son 
 361        else  
 362          grand right :> son 
 363        cur adjust_count 
 364        fat adjust_count 
 365        son adjust_count 
 366        node :> son 
 367   
 368  method index balanceonce -> c 
 369    arg_rw Index_ index ; arg CBool c 
 370    var Pointer:IndexNode_ fat :> index root 
 371    if addressof:fat=null 
 372      return false 
 373    var CBool balanced := false 
 374    while true 
 375      var Pointer:IndexNode_ cur :> fat biggest_son 
 376      if addressof:cur=null 
 377        return balanced 
 378      if 3*cur:nb>2*fat:nb 
 379        fat :> index twist fat cur cur:biggest_son ; balanced := true 
 380      else 
 381        fat :> cur 
 382   
 383  method index balance 
 384    arg_rw Index_ index 
 385    while index:balanceonce 
 386      void 
 387   
 388   
 389  method index insert key ahead value cmp offset keytype valuetype nodetype nodeisobj -> cursor 
 390    arg_rw Index_ index ; arg Address key ; arg CBool ahead ; arg Address value ; arg Function cmp ; arg Int offset ; arg Type keytype valuetype nodetype ; arg CBool nodeisobj ; arg Address cursor 
 391    var Int c ; var Int mode := shunt ahead compare_inferior+compare_equal compare_inferior 
 392    var Pointer:IndexNode_ fat :> null map IndexNode_ 
 393    var Pointer:IndexNode_ cur :> index root 
 394    while addressof:cur<>null 
 395      if addressof:fat<>null and 3*cur:nb>2*fat:nb 
 396        fat nb -= 1 
 397        cur :> index twist fat cur cur:biggest_son 
 398        fat :> cur father 
 399      else 
 400        cur nb += 1 
 401        fat :> cur 
 402        := compare (key map Universal) cur:key 
 403        cur :> shunt (.and. mode)<>cur:left cur:right 
 404    var Pointer:IndexNode_ node 
 405    if nodeisobj 
 406      node :> entry_new:nodetype map IndexNode_ 
 407      entry_lock addressof:node 
 408    else 
 409      node :> (memory_allocate nodetype:size addressof:index) map IndexNode_ 
 410      nodetype build_instance addressof:node 
 411    keytype copy_instance key (addressof node:key) 
 412    if value<>null 
 413      valuetype copy_instance value node:value 
 414    node left :> null map IndexNode_ 
 415    node right :> null map IndexNode_ 
 416    node father :> fat 
 417    node nb := 1 
 418    if addressof:fat=null 
 419      index root :> node 
 420    eif (.and. mode)<>0 
 421      fat left :> node 
 422    else 
 423      fat right :> node 
 424    cursor := node value 
 425    # index balanceonce 
 426   
 427   
 428  method index move old new 
 429    arg_rw Index_ index ; arg_rw IndexNode_ old new 
 430    check addressof:new<>addressof:old 
 431    var Pointer:IndexNode_ fat :> old father 
 432    var Pointer:IndexNode_ left :> old left 
 433    var Pointer:IndexNode_ right :> old right 
 434    if addressof:fat=null 
 435      check (addressof index:root)=addressof:old 
 436      index root :> new 
 437    eif (addressof fat:left)=addressof:old 
 438      fat left :> new 
 439    eif (addressof fat:right)=addressof:old 
 440      fat right :> new 
 441    else 
 442      error "Corrupted node" 
 443    if addressof:left<>null 
 444      check (addressof left:father)=addressof:old 
 445      left father :> new 
 446    if addressof:right<>null 
 447      check (addressof right:father)=addressof:old 
 448      right father :> new 
 449    new left :> old left 
 450    new right :> old right 
 451    new father :> old father 
 452    new nb := old nb 
 453   
 454  method index remove cursor offset nodetype nodeisobj -> cursor2 
 455    arg_rw Index_ index ; arg Address cursor ; arg Int offset ; arg Type nodetype ; arg CBool nodeisobj ; arg Address cursor2 
 456    check cursor<>null 
 457    var Pointer:IndexNode_ node :> cursor node 
 458    var Pointer:IndexNode_ next 
 459    if (addressof node:right)=null 
 460      next :> node 
 461      cursor2 := index next cursor offset 
 462    else 
 463      next :> node right 
 464      while (addressof next:left)<>null 
 465        next :> next left 
 466      cursor2 := next value 
 467    var Pointer:IndexNode_ cur :> next father 
 468    while addressof:cur<>null 
 469      cur nb -= 1 
 470      cur :> cur father 
 471    var Pointer:IndexNode_ son :> shunt (addressof next:left)<>null next:left next:right 
 472    var Pointer:IndexNode_ fat :> next father 
 473    if addressof:fat=null 
 474      check (addressof index:root)=addressof:next 
 475      index root :> son 
 476    eif (addressof fat:left)=addressof:next 
 477      fat left :> son 
 478    else 
 479      check (addressof fat:right)=addressof:next 
 480      fat right :> son 
 481    if addressof:son<>null 
 482      son father :> fat 
 483    if addressof:next<>addressof:node 
 484      index move node next 
 485    node left :> null map IndexNode_ 
 486    node right :> null map IndexNode_ 
 487    node father :> null map IndexNode_ 
 488    node nb := undefined 
 489    if nodeisobj 
 490      entry_unlock addressof:node 
 491    else 
 492      nodetype destroy_instance addressof:node 
 493      memory_free addressof:node 
 494    index balanceonce 
 495   
 496   
 497 
 
 498   
 499   
 500  function copy src dest cmp offset keytype valuetype nodetype nodeisobj 
 501    arg Index_ src ; arg_rw Index_ dest ; arg Function cmp ; arg Int offset ; arg Type keytype valuetype nodetype ; arg CBool nodeisobj 
 502    dest reset nodetype nodeisobj 
 503    var Address cursor := src first offset 
 504    while cursor<>null 
 505      dest insert (addressof cursor:node:key) false cursor:node:value cmp offset keytype valuetype nodetype nodeisobj 
 506      cursor := src next cursor offset 
 507   
 508   
 509  method index key cursor offset -> k 
 510    arg Index_ index ; arg Address cursor ; arg Int offset ; arg Address k 
 511    := addressof cursor:node:key 
 512   
 513  method index size -> n 
 514    arg Index_ index ; arg Int n 
 515    := index:root safe_nb 
 516   
 517   
 518  method index is_deleted cursor offset -> d 
 519    arg Index_ index ; arg Int offset ; arg Address cursor ; arg Int offset ; arg CBool d 
 520    var Pointer:IndexNode_ node :> cursor node 
 521    := node:nb=undefined 
 522   
 523  export Index_ '. reset' '. check' '. balance' 
 524  export Index_ '. first' '. last' '. next' '. previous' '. from' '. to' '. insert' '. remove' 
 525  export copy '. key' '. size' '. is_deleted' 
 526  export IndexNode_ 
 527   
 528   
 529 
 
 530  #   now the generic type 
 531   
 532   
 533  gvar Relation 'pliant index types' 
 534  export 'pliant index types' 
 535   
 536  function find_compare_function t -> f 
 537    arg Type t ; arg_RW Function f 
 538    var Pointer:Arrow :> pliant_general_dictionary first "compare" 
 539    while c<>null 
 540      if entry_type:c=Function 
 541        :> map Function 
 542        if f:nb_args_with_result=and (arg 0):type=and (arg 1):type=and (arg 2):type=Int 
 543          return 
 544      :> pliant_general_dictionary next "compare" c 
 545    :> null map Function 
 546   
 547   
 548  function Index key value -> t 
 549    arg Type key value ; arg_R Type t 
 550    has_no_side_effect 
 551   
 552    var Address adr := 'pliant index types' query addressof:key addressof:value 
 553    if adr<>null 
 554      return (adr map Type) 
 555   
 556    var Pointer:Function cmp :> find_compare_function key 
 557    if addressof:cmp=null 
 558      error error_id_compile "There is no comparison function available for "+key:name 
 559      :> Void ; return 
 560   
 561    runtime_compile  Key key  Value value  Index (cast "(Index "+key:name+" "+value:name+")" Ident)  compare_keys (cast "compare keys "+key:name+" "+value:name Ident)  IndexNode (cast "(IndexNode "+key:name+" "+value:name+")" Ident)  value_offset (cast "offset "+key:name+" "+value:name Ident)  compare_function cmp 
 562   
 563      function compare_keys k1 k2 -> c 
 564        arg Universal k1 k2 ; arg Int c 
 565        c := compare_function (addressof:k1 map Key) (addressof:k2 map Key) 
 566   
 567      type IndexNode 
 568        field IndexNode_ node 
 569        field Key key 
 570        field Value value 
 571   
 572      constant value_offset (IndexNode field 2):offset 
 573   
 574      type Index 
 575        field Index_ tree 
 576   
 577      function destroy i 
 578        arg_w Index i 
 579        i:tree reset IndexNode false 
 580   
 581      method i first -> v 
 582        arg Index i ; arg_C Value v 
 583        # v :> (i:tree first value_offset) map Value 
 584        (addressof Pointer:Value v) map Address := i:tree first value_offset 
 585   
 586      method i last -> v 
 587        arg Index i ; arg_C Value v 
 588        # v :> (i:tree last value_offset) map Value 
 589        (addressof Pointer:Value v) map Address := i:tree last value_offset 
 590   
 591      method i next v1 -> v2 
 592        arg Index i ; arg_r Value v1 ; arg_C Value v2 
 593        # v2 :> (i:tree next addressof:v1 value_offset) map Value 
 594        (addressof Pointer:Value v2) map Address := i:tree next (addressof Value v1) value_offset 
 595   
 596      method i previous v1 -> v2 
 597        arg Index i ; arg_r Value v1 ; arg_C Value v2 
 598        # v2 :> (i:tree previous addressof:v1 value_offset) map Value 
 599        (addressof Pointer:Value v2) map Address := i:tree previous (addressof Value v1) value_offset 
 600   
 601      method i first k -> v 
 602        arg Index i ; arg Key k ; arg_C Value v 
 603        # v :> (i:tree first (addressof Key k) (the_function compare_keys Universal Universal -> Int) value_offset) map Value 
 604        (addressof Pointer:Value v) map Address := i:tree first (addressof Key k) (the_function compare_keys Universal Universal -> Int) value_offset 
 605   
 606      method i next k v1 -> v2 
 607        arg Index i ; arg Key k ; arg_r Value v1 ; arg_C Value v2 
 608        # v2 :> (i:tree next (addressof Key k) addressof:v1 (the_function compare_keys Universal Universal -> Int) value_offset) map Value 
 609        (addressof Pointer:Value v2) map Address := i:tree next (addressof Key k) addressof:v1 (the_function compare_keys Universal Universal -> Int) value_offset 
 610   
 611      method i from k -> v 
 612        arg Index i ; arg Key k ; arg_C Value v 
 613        # v :> (i:tree from (addressof Key k) (the_function compare_keys Universal Universal -> Int) value_offset) map Value 
 614        (addressof Pointer:Value v) map Address := i:tree from (addressof Key k) (the_function compare_keys Universal Universal -> Int) value_offset 
 615   
 616      method i to k -> v 
 617        arg Index i ; arg Key k ; arg_C Value v 
 618        # v :> (i:tree to (addressof Key k) (the_function compare_keys Universal Universal -> Int) value_offset) map Value 
 619        (addressof Pointer:Value v) map Address := i:tree to (addressof Key k) (the_function compare_keys Universal Universal -> Int) value_offset 
 620   
 621      method i exists k -> c 
 622        arg Index i ; arg Key k ; arg CBool c 
 623        c := (i:tree first (addressof Key k) (the_function compare_keys Universal Universal -> Int) value_offset)<>null 
 624         
 625      method i insert k v -> v2 
 626        arg_rw Index i ; arg Key k ; arg Value v ; arg_C Value v2 
 627        # v2 :> (i:tree insert (addressof Key k) false (addressof Value v) (the_function compare_keys Universal Universal -> Int) value_offset Key Value IndexNode false) map Value 
 628        (addressof Pointer:Value v2) map Address := i:tree insert (addressof Key k) false (addressof Value v) (the_function compare_keys Universal Universal -> Int) value_offset Key Value IndexNode false 
 629   
 630      method i remove v -> v2 
 631        arg_rw Index i ; arg_r Value v ; arg_C Value v2 
 632        # v2 :> (i:tree remove (addressof Value v) IndexNode false) map Value 
 633        (addressof Pointer:Value v2) map Address := i:tree remove (addressof Value v) value_offset IndexNode false 
 634   
 635      method i key v -> k 
 636        arg Index i ; arg_r Value v ; arg_R Key k 
 637        k :> (i:tree key (addressof Value v) value_offset) map Key 
 638   
 639      method i check 
 640        arg Index i 
 641        i:tree check (the_function compare_keys Universal Universal -> Int) 
 642   
 643      function '-=' i v 
 644        arg_rw Index i ; arg_r Value v 
 645        i:tree remove (addressof Value v) value_offset IndexNode false 
 646   
 647      method i '' k -> v 
 648        arg Index i ; arg Key k ; arg_C Value v 
 649        # v :> i first k 
 650        (addressof Pointer:Value v) map Address := addressof Value (i first k) 
 651        if (addressof Value v)=null 
 652          error error_id_missing "there is no such key in the Index" 
 653   
 654      method i size -> n 
 655        arg Index i ; arg Int n 
 656        n := i:tree size 
 657   
 658      function copy src dest 
 659        arg Index src ; arg_w Index dest 
 660        copy src:tree dest:tree (the_function compare_keys Universal Universal -> Int) value_offset Key Value IndexNode false 
 661   
 662      export Index '' '. first' '. last' '. next' '. previous' '. from' '. to' '. exists' '. insert' '. remove' '. key' '. check' '-=' '. size' 
 663      'pliant index types' define addressof:Key addressof:Value addressof:Index 
 664      'pliant set types' define addressof:Index addressof:Index addressof:(new Str "Index") 
 665      'pliant set types' define addressof:Index null addressof:Key 
 666      'pliant set types' define null addressof:Index addressof:Value 
 667   
 668    var Address adr := 'pliant index types' query addressof:key addressof:value 
 669    check adr<>null 
 670    return (adr map Type) 
 671   
 672  export Index 
 673   
 674   
 675   
 676   
 677   
 678