/pliant/storage/database/pointer.pli
 
 1  abstract 
 2    [This module will define the 'Data' and 'Database' generic data types that the application will use in order to access a database, and that will completely hide the undertlying implementation.] 
 3   
 4  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 5  # 
 6  # This program is free software; you can redistribute it and/or 
 7  # modify it under the terms of the GNU General Public License version 2 
 8  # as published by the Free Software Foundation. 
 9  # 
 10  # This program is distributed in the hope that it will be useful, 
 11  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 12  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 13  # GNU General Public License for more details. 
 14  # 
 15  # You should have received a copy of the GNU General Public License 
 16  # version 2 along with this program; if not, write to the Free Software 
 17  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 18   
 19  scope "/pliant/storage/" "/pliant/appli/" 
 20  module "/pliant/language/compiler.pli" 
 21  module "/pliant/language/data/string_cast.pli" 
 22  module "/pliant/util/encoding/html.pli" 
 23  module "set.pli" 
 24  module "prototype.pli" 
 25  module "inmemory.pli" 
 26  module "io.pli" 
 27  module "file.pli" 
 28  module "mount.pli" 
 29  module "interface.pli" 
 30   
 31   
 32 
 
 33   
 34  doc 
 35    ['Data' is very much like 'Pointer', but it's dedicated to pointing objects in the database and ensure nice properties such as automatic locking, so you can use them safely in a multithreaded environment (the HTTP server), and not crashing if accessing a non existing data.] ; eol 
 36    [It will map objects implemented in ] ; link "inmemory.pli" "inmemory.pli" 
 37   
 38   
 39  gvar Relation 'pliant data types' 
 40  export 'pliant data types' 
 41   
 42  function Data t -> tt 
 43    arg Type t ; arg_R Type tt 
 44    has_no_side_effect 
 45   
 46    var Address adr := 'pliant data types' query addressof:null 
 47    if adr<>null 
 48      return (adr map Type) 
 49   
 50    runtime_compile  Value t  Data (cast "(Data "+t:name+")" Ident)  getdata (cast "cast "+t:name Ident)  is_field (cast (shunt data_kind:t=data_field "true" "false"Ident)  default (cast "default "+t:name Ident) 
 51   
 52      type Data 
 53        field Data_ data 
 54   
 55      if is_field 
 56   
 57        from_string addressof:(gvar Value default) Value "" "db" 
 58   
 59        function getdata d -> v 
 60          arg Data d ; arg Value v 
 61          implicit 
 62          if (d:data:interface get d:data addressof:v Value)=failure 
 63            v := default 
 64   
 65      export Data '. data' 
 66      if is_field 
 67        export getdata 
 68      'pliant data types' define addressof:Value null addressof:Data 
 69      'pliant data types' define null addressof:Data addressof:Value 
 70      (addressof:'pliant star types' map Relation) define addressof:Data null addressof:Value 
 71   
 72    var Address adr := 'pliant data types' query addressof:null 
 73    check adr<>null 
 74    return (adr map Type) 
 75   
 76  export Data 
 77  alias Anything Anything from "/pliant/storage/database/inmemory.pli" 
 78  export Anything 
 79   
 80   
 81 
 
 82   
 83  doc 
 84    ['Database' is the generic data type that will store in memory all the data of a database, enable to load or store them to the disk using a single command, and update the log so that in case of an application crash, no data will be lost.] ; eol 
 85    [A 'Database' object is the visible part (the one the application uses) or an underlying '] ; link "DatabaseFile" "file.pli" ; [' object.] 
 86   
 87   
 88  gvar Relation 'pliant database types' 
 89  export 'pliant database types' 
 90   
 91  function Database t -> tt 
 92    arg Type t ; arg_R Type tt 
 93    has_no_side_effect 
 94   
 95    var Address adr := 'pliant database types' query addressof:null 
 96    if adr<>null 
 97      return (adr map Type) 
 98   
 99    Data t 
 100    runtime_compile  Value t  Database (cast "(Database "+t:name+")" Ident)  Data (cast "(Data "+t:name+")" Ident)  casttodata (cast "cast (Data "+t:name+")" Ident)  interface_arrow (cast "interface "+t:name Ident) 
 101   
 102      type Database 
 103        field DatabaseFile file 
 104        field Value value 
 105   
 106      DatabaseFile maybe Database 
 107   
 108      constant interface_arrow (cast (addressof data_interface:Value) Arrow) 
 109      function build db 
 110        arg_w Database db 
 111        db:file:root_interface :> interface_arrow omap DataInterface_ 
 112      function destroy db # Must be defined, else (function destroy DatabaseFile) will be inherited, so called twice 
 113        arg_w Database db 
 114   
 115      method db data -> d 
 116        oarg Database db ; arg Data d 
 117        (addressof:db omap Database_) get_root (addressof:d map Data_) 
 118      ((the_function '. data' Database -> Data) arg 1) access += access_result_consistent 
 119    
 120      export '. data' 
 121      'pliant database types' define addressof:Value null addressof:Database 
 122      'pliant database types' define null addressof:Database addressof:Value 
 123   
 124    var Address adr := 'pliant database types' query addressof:null 
 125    check adr<>null 
 126    return (adr map Type) 
 127       
 128   
 129  method a is_data -> c 
 130    arg Type a ; arg CBool c 
 131    has_no_side_effect 
 132    := ('pliant data types' query null addressof:a)<>null 
 133   
 134  method e is_data -> c 
 135    arg_rw Expression e ; arg CBool c 
 136    := false 
 137    compile ? 
 138    uncast 
 139    var Link:Type :> e:result type 
 140    while not t:is_data 
 141      if not t:is_pointer 
 142        return 
 143      :> unpointerto t 
 144    if not (cast t) 
 145      return 
 146    := true 
 147   
 148   
 149  meta '. load' e 
 150    if e:size<or not (e:cast DatabaseFile) or not (e:cast Str) 
 151      return 
 152    var Link:Argument log :> e:1:result 
 153    var Link:Argument mount :> argument constant Str "" 
 154    var Int := 2 
 155    while i<e:size 
 156      if e:i:ident="log" and i+1<e:size and (e:(i+1) cast Str) 
 157        suckup e:(i+1) 
 158        log :> e:(i+1):result 
 159        += 2 
 160      eif e:i:ident="mount" and i+1<e:size and (e:(i+1) cast Str) 
 161        suckup e:(i+1) 
 162        mount :> e:(i+1):result 
 163        += 2 
 164      eif e:i:ident="nolog" 
 165        log :> argument constant Str "" 
 166        += 1 
 167      else 
 168        return 
 169    suckup e:0 ; suckup e:1 
 170    add (instruction (the_function '. setup' DatabaseFile Str Str Str) e:0:result e:1:result log mount) 
 171    set_void_result 
 172   
 173  meta '. store' e 
 174    if e:size=and (e:cast DatabaseFile) 
 175      var Link:Argument :> argument local Status 
 176      suckup e:0 
 177      add (instruction (the_function '. store' DatabaseFile -> Status) e:0:result s) 
 178      set_result access_read 
 179   
 180  meta '. query' e 
 181    if e:size=and (e:cast DatabaseFile) and (e:cast Str) 
 182      var Link:Argument :> argument local Str 
 183      suckup e:0 ; suckup e:1 
 184      add (instruction (the_function '. query' Database_ Str -> Str) e:0:result e:1:result a) 
 185      set_result access_read 
 186   
 187  meta '. configure' e 
 188    if e:size=and (e:cast DatabaseFile) and (e:cast Str) 
 189      var Link:Argument :> argument local Status 
 190      suckup e:0 ; suckup e:1 
 191      add (instruction (the_function '. configure' Database_ Str -> Status) e:0:result e:1:result s) 
 192      set_result access_read 
 193   
 194   
 195  export Database 
 196  export '. is_data' 
 197  export '. load' '. store' '. query' '. configure' 
 198   
 199  alias data_store data_store from "/pliant/storage/database/file.pli" 
 200  alias data_file_switch data_file_switch from "/pliant/storage/database/file.pli" 
 201  export data_store data_file_switch 
 202   
 203   
 204 
 
 205   
 206   
 207  doc 
 208    [Sets a Data pointer.] 
 209   
 210  meta ':>' e 
 211    if e:size<>2 
 212      return 
 213    if not e:0:is_data or (e:0:access .and. access_write)=0 
 214      return 
 215    var Pointer:Type :> unpointerto e:0:result:type 
 216    e:compile ? 
 217    if addressof:(e:cast e:1:result e:1:access Data:function_flag_implicit .or. function_flag_extension .or. function_flag_reduction)=null 
 218      return 
 219    suckup e:1 
 220    suckup e:0 
 221    add (instruction (the_function 'copy Universal' Universal Universal Type) e:1:result e:0:result (argument mapped_constant Type Data_)) 
 222    set_void_result 
 223       
 224     
 225  doc 
 226    [Set the value of a field.] 
 227   
 228  function data_set d v t 
 229    arg_rw Data_ d ; arg Universal v ; arg Type t 
 230    d:base:sem request "database set "+d:path 
 231    d:interface set addressof:t 
 232    d:base:sem release 
 233   
 234  meta ':=' e 
 235    if e:size<>or not e:0:is_data or (e:0:access .and. access_write)=0 
 236      return 
 237    var Link:Type :> unpointerto e:0:result:type 
 238    if data_kind:t<>data_field 
 239      return 
 240    e:compile ? 
 241    if addressof:(e:cast e:1:result e:1:access function_flag_implicit .or. function_flag_extension .or. function_flag_reduction)=null 
 242      return 
 243    suckup e:1 
 244    suckup e:0 
 245    add (instruction (the_function data_set Data_ Universal Type) e:0:result e:1:result (argument mapped_constant Type t)) 
 246    set_void_result 
 247       
 248   
 249  doc 
 250    [Get a field in a record.] 
 251   
 252  function map_field r def -> f 
 253    arg_rw Data_ r ; arg DataRecordFieldDef def ; arg Data_ f 
 254    if (addressof r:interface)=(addressof def:record_interface) 
 255      def apply f 
 256    else 
 257      r:base:sem rd_request "database map field "+r:path+def:path 
 258      := r:interface search html_decode:(def:path def:path:len) false 
 259      r:base:sem rd_release 
 260      if f:adr=null 
 261        object := def default 
 262   
 263  meta '' e 
 264    if e:size<>or not e:1:is_pure_ident or not e:0:is_data 
 265      return 
 266    var Link:Type :> unpointerto e:0:result:type 
 267    if entry_type:(addressof data_interface:t)<>DataRecord 
 268      return 
 269    var Pointer:DataRecord :> (addressof data_interface:t) map DataRecord 
 270    for (var Int i) t:nb_fields-1 
 271      var Pointer:TypeField :> field i 
 272      if f:name=e:1:ident 
 273        var Link:Type dt :> Data f:type 
 274        var Link:Argument :> argument local dt 
 275        suckup e:0 
 276        var Pointer:DataRecordFieldDef def :> (r:fields first f:name) map DataRecordFieldDef 
 277        add (instruction (the_function map_field Data_ DataRecordFieldDef -> Data_) e:0:result (argument mapped_constant DataRecordFieldDef def) a) 
 278        set_result access_read+(e:0:access .and. access_write) 
 279        return 
 280   
 281   
 282  doc 
 283    [Get a record in a set.] 
 284   
 285  function map_record s key -> r 
 286    arg_rw Data_ s ; arg Str key ; arg Data_ r 
 287    s:base:sem rd_request "database map record "+s:path+"/"+html_decode:key 
 288    := s:interface search key false 
 289    s:base:sem rd_release 
 290   
 291  meta '' e 
 292    if e:size<>or not (e:cast Str) or not e:0:is_data 
 293      return 
 294    var Link:Type :> unpointerto e:0:result:type 
 295    if data_kind:t<>data_set 
 296      return 
 297    var Link:Argument :> argument local (Data t:value_type) 
 298    suckup e:0 ; suckup e:1 
 299    add (instruction (the_function map_record Data_ Str -> Data_) e:0:result e:1:result a) 
 300    set_result access_read+(e:0:access .and. access_write) 
 301   
 302   
 303  doc 
 304    [Get the number of records in a set.] 
 305   
 306  function data_size s -> n 
 307    arg_rw Data_ s ; arg Int n 
 308    s:base:sem rd_request "database get size "+s:path 
 309    := s:interface count "" "" 
 310    s:base:sem rd_release 
 311   
 312  meta '. size' e 
 313    if e:size<>or not e:0:is_data 
 314      return 
 315    var Link:Type :> unpointerto e:0:result:type 
 316    if data_kind:t<>data_set 
 317      return 
 318    var Link:Argument :> argument local Int 
 319    suckup e:0 
 320    add (instruction (the_function data_size Data_ -> Int) e:0:result a) 
 321    set_result access_read 
 322   
 323   
 324  doc 
 325    [Create a record in a set.] 
 326   
 327  function data_create s key -> status 
 328    arg_rw Data_ s ; arg Str key ; arg Status status 
 329    s:base:sem request "database create "+s:path+"/"+html_encode:key 
 330    status := s:interface create key 
 331    s:base:sem release 
 332   
 333  function data_create s key record -> status 
 334    arg_rw Data_ s ; arg Str key ; arg Type record ; arg Status status 
 335    s:base:sem request "database create "+s:path+"/"+html_encode:key 
 336    status := s:interface create key 
 337    if status=success 
 338      var Data_ := s:interface search key 
 339      for (var Int i) record:nb_fields-1 
 340        r:interface create r (record field i):name 
 341    s:base:sem release 
 342   
 343  meta '. create' e 
 344    if e:size<>or not (e:cast Str) or not e:0:is_data 
 345      return 
 346    var Link:Type :> unpointerto e:0:result:type 
 347    if data_kind:t<>data_set 
 348      return 
 349    var Link:Type :> value_type 
 350    var Link:Argument :> argument local Status 
 351    suckup e:0 ; suckup e:1 
 352    if exists:and data_kind:v=data_record 
 353      add (instruction (the_function data_create Data_ Str Type -> Status) e:0:result e:1:result (argument mapped_constant Type v) a) 
 354    else 
 355      add (instruction (the_function data_create Data_ Str -> Status) e:0:result e:1:result a) 
 356    set_result access_read 
 357   
 358   
 359  doc 
 360    [Delete a record in a set.] 
 361   
 362  function data_delete s key -> status 
 363    arg_rw Data_ s ; arg Str key ; arg Status status 
 364    s:base:sem request "database delete "+s:path+"/"+html_encode:key 
 365    status := s:interface delete key 
 366    s:base:sem release 
 367   
 368  meta '. delete' e 
 369    if e:size<>or not (e:cast Str) or not e:0:is_data 
 370      return 
 371    var Link:Type :> unpointerto e:0:result:type 
 372    if data_kind:t<>data_set 
 373      return 
 374    var Link:Argument :> argument local Status 
 375    suckup e:0 ; suckup e:1 
 376    add (instruction (the_function data_delete Data_ Str -> Status) e:0:result e:1:result a) 
 377    set_result access_read 
 378   
 379   
 380 
 
 381   
 382   
 383  doc 
 384    [Test if we are pointing to a data that already exists.] 
 385   
 386  function data_exists d -> c 
 387    arg_rw Data_ d ; arg CBool c 
 388    := d:adr<>null 
 389   
 390  meta exists e 
 391    if e:size<>or not e:0:is_data 
 392      return 
 393    var Link:Type :> unpointerto e:0:result:type 
 394    var Link:Argument :> argument local CBool 
 395    suckup e:0 
 396    add (instruction (the_function data_exists Data_ -> CBool) e:0:result a) 
 397    set_result access_read 
 398   
 399   
 400  doc 
 401    [Get the key of the data. The key is the last level in the data path.] 
 402   
 403  meta keyof e 
 404    if e:size<>or not e:0:is_data 
 405      return 
 406    var Link:Type :> unpointerto e:0:result:type 
 407    var Link:Argument :> argument local Str 
 408    suckup e:0 
 409    add (instruction (the_function '. key' Data_ -> Str) e:0:result a) 
 410    set_result access_read 
 411   
 412   
 413  doc 
 414    [Get the all path to the data.] 
 415   
 416  meta pathof e 
 417    if e:size<>or not e:0:is_data 
 418      return 
 419    var Link:Type :> unpointerto e:0:result:type 
 420    var Link:Argument :> argument local Str 
 421    suckup e:0 
 422    add (instruction (the_function '. path' Data_ -> Str) e:0:result a) 
 423    set_result access_read 
 424   
 425   
 426  doc 
 427    [Get a pointer to a data specifyed using it's path.] 
 428   
 429  method d1 search_path path createit -> d2 
 430    arg Data_ d1 ; arg Str path ; arg CBool createit ; arg Data_ d2 
 431    var Pointer:Database_ :> d1 base 
 432    b:sem rd_request "database search path "+d1:path+" "+path 
 433    var CBool rw := false 
 434    d2 := d1 
 435    var Str := path 
 436    while (parse "/" any:(var Str k) "/" any:(var Str remain)) 
 437      if (addressof d2:base:sem)<>(addressof b:sem) 
 438        if rw 
 439          b:sem release 
 440        else 
 441          b:sem rd_release 
 442        :> d2 base 
 443        if rw 
 444          b:sem request "database search path "+d1:path+" "+path 
 445        else 
 446          b:sem rd_request "database search path "+d1:path+" "+path 
 447      var Data_ temp := d2:interface search d2 html_decode:k 
 448      if temp:adr=null and createit 
 449        if not rw 
 450          b:sem rd_release 
 451          b:sem request "database search path "+d1:path+" "+path 
 452          rw := true 
 453        if (d2:interface create d2 html_decode:k)=success 
 454          temp := d2:interface search d2 html_decode:k 
 455      d2 := temp ; := "/"+remain 
 456    if (parse "/" any:(var Str k)) 
 457      if (addressof d2:base:sem)<>(addressof b:sem) 
 458        if rw 
 459          b:sem release 
 460        else 
 461          b:sem rd_release 
 462        :> d2 base 
 463        if rw 
 464          b:sem request "database search path "+d1:path+" "+path 
 465        else 
 466          b:sem rd_request "database search path "+d1:path+" "+path 
 467      var Data_ temp := d2:interface search d2 html_decode:k 
 468      if temp:adr=null and createit 
 469        if not rw 
 470          b:sem rd_release 
 471          b:sem request "database search path "+d1:path+" "+path 
 472          rw := true 
 473        if (d2:interface create d2 html_decode:k)=success 
 474          temp := d2:interface search d2 html_decode:k 
 475      d2 := temp 
 476    if rw 
 477      b:sem release 
 478    else 
 479      b:sem rd_release 
 480   
 481  meta '. pmap' e 
 482    if e:size=and (e:cast Str) and (e:constant Type)<>null 
 483      var Pointer:Type :> (e:constant Type) map Type 
 484      var Link:Argument :> argument local Data:t 
 485      suckup e:0 
 486      add (instruction (the_function '. search_path' Data_ Str CBool -> Data_) (argument mapped_constant Data_ data_root) e:0:result (argument constant CBool false) a) 
 487      set_result access_read+access_write 
 488    eif e:size=and e:0:is_data and (e:cast Str) and (e:constant Type)<>null 
 489      var Pointer:Type :> (e:constant Type) map Type 
 490      var Link:Argument :> argument local Data:t 
 491      suckup e:0 ; suckup e:1 
 492      add (instruction (the_function '. search_path' Data_ Str CBool -> Data_) e:0:result e:1:result (argument constant CBool false) a) 
 493      set_result access_read+(e:0:access .and. access_write) 
 494   
 495   
 496  function data_reset d 
 497    arg_rw Data_ d 
 498    d:base:sem request "database reset "+d:path 
 499    d:interface reset d 
 500    d:base:sem release 
 501   
 502  meta data_reset e 
 503    if e:size<>or not e:0:is_data or (e:0:access .and. access_write)=0 
 504      return 
 505    suckup e:0 
 506    add (instruction (the_function data_reset Data_) e:0:result) 
 507    set_void_result 
 508       
 509   
 510  doc 
 511    ['data_copy' will allow you to copy datas that have completely different type, the mapping beeing performed though matching subpath.] 
 512   
 513  function data_rec_copy src dest 
 514    arg_rw Data_ src dest 
 515    var Pointer:Type :> src:interface type src 
 516    if t<>Void 
 517      var Arrow := entry_new t 
 518      if (src:interface get src t)=success 
 519        dest:interface set dest t 
 520    var Data_ src2 := src:interface first src "" "" (var DataScanBuffer buf) 
 521    while src2:adr<>null 
 522      var Data_ dest2 := dest:interface search dest src2:key true 
 523      if dest2:adr<>null 
 524        data_rec_copy src2 dest2 
 525      src2 := src:interface next src "" "" buf 
 526   
 527  function data_copy src dest 
 528    arg_rw Data_ src dest 
 529    part copy "database copy "+src:path+" -> "+dest:path 
 530      dest:base:sem request 
 531      if (addressof src:base:sem)<>(addressof dest:base:sem) 
 532        src:base:sem rd_request 
 533      dest:interface reset dest 
 534      data_rec_copy src dest 
 535      if (addressof src:base:sem)<>(addressof dest:base:sem) 
 536        src:base:sem rd_release 
 537      dest:base:sem release 
 538   
 539  meta data_copy e 
 540    if e:size<>or not e:0:is_data or not e:1:is_data or (e:1:access .and. access_write)=0 
 541      return 
 542    suckup e:0 ; suckup e:1 
 543    add (instruction (the_function data_copy Data_ Data_) e:0:result e:1:result) 
 544    set_void_result 
 545   
 546   
 547 
 
 548   
 549   
 550  doc 
 551    [And now the big 'each' meta that will allow to scan all the elements of a set, filter them, and sort them.] 
 552   
 553  function scan_first d c buf -> some 
 554    arg Data_ d ; arg_w Data_ c ; arg_w DataScanBuffer buf ; arg CBool some 
 555    var Pointer:Database_ db :> base 
 556    db:sem rd_request "database search first "+d:path 
 557    := d:interface first "" "" buf 
 558    db:sem rd_release 
 559    some := c:adr<>null 
 560   
 561  function scan_next d c buf -> some 
 562    arg Data_ d ; arg_w Data_ c ; arg_rw DataScanBuffer buf ; arg CBool some 
 563    var Pointer:Database_ db :> base 
 564    db:sem rd_request "database search next "+d:path 
 565    := d:interface next "" "" buf 
 566    db:sem rd_release 
 567    some := c:adr<>null 
 568   
 569  function is_null a -> c 
 570    arg Address a ; arg CBool c 
 571    := a=null 
 572   
 573  function pick_function id t0 t1 t2 t3 n r m -> f 
 574    arg Str id ; arg Type t0 t1 t2 t3 ; arg Int r ; arg Module m ; arg_R Function f 
 575    for (var Int lap) 0 1 
 576      var Link:Module module 
 577      if lap=0 
 578        module :> m 
 579      else 
 580        module :> the_module "/pliant/language/type/set/index.pli" 
 581      var Pointer:Arrow :> module first id 
 582      while c<>null 
 583        if entry_type:c=Function 
 584          :> map Function 
 585          if f:nb_args=and f:nb_args_with_result=and (not exists:t0 or (arg 0):type=t0) and (not exists:t1 or (arg 1):type=t1) and (not exists:t2 or (arg 2):type=t2) and (not exists:t3 or (arg 3):type=t3) 
 586            return 
 587        :> module next id c 
 588    :> null map Function 
 589    error error_id_compile "failed to pick function "+id 
 590   
 591  meta each e 
 592    if e:size<or not e:0:is_pure_ident 
 593      return 
 594    var Pointer:Expression filter :> null map Expression 
 595    var Pointer:Expression sort :> null map Expression 
 596    var CBool reversed := false 
 597    var Int := 2 
 598    while i<e:size-1 
 599      if e:i:ident="filter" and i+1<e:size-1 
 600        filter :> i+1 
 601        += 2 
 602      eif e:i:ident="sort" and i+1<e:size-1 
 603        sort :> i+1 
 604        += 2 
 605      eif e:i:ident="reversed" and exists:sort 
 606        reversed := true 
 607        += 1 
 608      else 
 609        return 
 610    e:compile ? 
 611    var Pointer:Type set :> e:1:result:type:real_data_type 
 612    if set:category<>"Set" 
 613      return 
 614    var Link:Argument buf :> argument local DataScanBuffer 
 615    var Link:Argument some :> argument local CBool 
 616    var Link:Argument item :> local_variable e:0 (Data set:value_type) 
 617    if not exists:item 
 618      return 
 619    if addressof:filter<>null and not (filter cast CBool) 
 620      return 
 621    if addressof:sort<>null 
 622      sort compile ? 
 623      var Pointer:Type key :> sort:result:type real_data_type 
 624      if not (sort cast key) 
 625        return 
 626      var Link:Argument idx :> argument local (Index key Data_) 
 627      var Link:Argument adr :> argument local Address 
 628      add (instruction (the_function 'address Universal' Universal -> Address) idx adr) 
 629      add (instruction (the_function '. destroy_instance' Type Address) (argument mapped_constant Type (Index key Data_)) adr) 
 630      add (instruction (the_function '. build_instance' Type Address) (argument mapped_constant Type (Index key Data_)) adr) 
 631    (e:size-1) compile ? 
 632    e:cast Data:set ; suckup e:1 
 633    var Link:Instruction next :> instruction the_function:'do nothing' 
 634    var Link:Instruction end :> instruction the_function:'do nothing' 
 635    add (instruction (the_function scan_first Data_ Data_ DataScanBuffer -> CBool) e:1:result item buf some) 
 636    add (instruction (the_function 'jump if not' CBool) some jump end) 
 637    var Link:Instruction body :> instruction the_function:'do nothing' 
 638    add body 
 639    if addressof:filter<>null 
 640      suckup filter 
 641      add (instruction (the_function 'jump if not' CBool) filter:result jump next) 
 642    if addressof:sort=null 
 643      suckup (e:size-1) 
 644    else 
 645      suckup sort 
 646      var Link:Function :>pick_function ". insert" (Index key Data_) key Data_ Data_ 3 4 e:module ? 
 647      add (instruction idx sort:result item (argument indirect Data_ (argument local Address) 0)) 
 648    if addressof:filter<>null 
 649      add next 
 650    add (instruction (the_function scan_next Data_ Data_ DataScanBuffer -> CBool) e:1:result item buf some) 
 651    add (instruction (the_function 'jump if' CBool) some jump body) 
 652    add end 
 653    if addressof:sort<>null 
 654      var Link:Argument ptr :> argument local Address 
 655      var Link:Argument cursor :> argument indirect Data_ ptr 0 
 656      var Link:Argument cond :> argument local CBool 
 657      var Link:Instruction stop :> instruction the_function:'do nothing' 
 658      var Link:Function :> pick_function (shunt reversed ". last" ". first") (Index key Data_) Data_ (null map Type) (null map Type) 1 2 e:module ? 
 659      add (instruction idx cursor) 
 660      add (instruction (the_function is_null Address -> CBool) ptr cond) 
 661      add (instruction (the_function 'jump if' CBool) cond jump stop) 
 662      var Link:Instruction again :> instruction the_function:'do nothing' 
 663      add again 
 664      add (instruction (the_function 'copy Universal' Universal Universal Type) cursor item (argument mapped_constant Type Data_)) 
 665      suckup (e:size-1) 
 666      var Link:Function :>pick_function (shunt reversed ". previous" ". next") (Index key Data_) Data_ Data_ (null map Type) 2 3 e:module ? 
 667      add (instruction idx cursor cursor) 
 668      add (instruction (the_function is_null Address -> CBool) ptr cond) 
 669      add (instruction (the_function 'jump if not' CBool) cond jump again) 
 670      add stop 
 671    set_void_result 
 672   
 673   
 674  export '. search_path' 
 675   
 676  export ':>' ':=' '' '. size' '. create' '. delete' keyof pathof exists 
 677  export '. pmap' data_reset data_copy 
 678  export each