Patch title: Release 94 bulk changes
Abstract:
File: /pliant/storage/database/inmemory.pli
Key:
    Removed line
    Added line
abstract
  [The methods used to access datas stored in the main memory.]

# 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/storage/" "/pliant/appli/"
module "/pliant/language/compiler.pli"
module "/pliant/language/data/string_cast.pli"
module "/pliant/util/encoding/html.pli"
module "prototype.pli"
module "interface.pli"
module "set.pli"

public


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


type DataField
  field Link:Type type
  
DataInterface_ maybe DataField


method df type d -> t
  oarg DataField df ; arg Data_ d ; arg_R Type t
  t :> df type

method df get d adr type -> status
  oarg DataField df ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status
  if type=df:type
    type copy_instance d:adr adr
    status := success
  else
    var Str s := to_string d:adr df:type "db"
    status := from_string adr type s "db"

method df set d adr type -> status
  oarg_rw DataField df ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status
  if type=df:type
    type copy_instance adr d:adr
    status := success
  else
    var Str s := to_string adr type "db"
    status := from_string d:adr df:type s "db"
  if status=success
    d:base notify_set d d:adr df:type

method df get_raw d adr type -> status
  oarg DataField df ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status
  if type=df:type
    type copy_instance d:adr adr
    status := success
  else
    var Str s := to_string d:adr df:type "raw"
    status := from_string adr type s "raw"

method df set_raw d adr type -> status
  oarg_rw DataField df ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status
  if type=df:type
    type copy_instance adr d:adr
    status := success
  else
    var Str s := to_string adr type "raw"
    status := from_string d:adr df:type s "raw"
  if status=success
    d:base notify_set d d:adr df:type

method df reset d -> status
  oarg_rw DataField df ; arg_rw Data_ d ; arg Status status
  df:type destroy_instance d:adr
  df:type build_instance d:adr
  d:base notify_reset d
  status := success


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


type DataRecordFieldDef
  field Pointer:DataInterface_ record_interface
  field Int offset
  field Link:DataInterface_ interface
  field Str path
  field Arrow default

type DataRecord
  field Link:Type type
  field Dictionary fields
  field List all_fields
  
DataInterface_ maybe DataRecord


method dr reset d -> status
  oarg_rw DataRecord dr ; arg_rw Data_ d ; arg Status status
  dr:type destroy_instance d:adr
  dr:type build_instance d:adr
  d:base notify_reset d
  status := success


method f apply d d2
  arg DataRecordFieldDef f ; arg Data_ d ; arg_w Data_ d2
  d2 adr := d:adr translate Byte f:offset
  d2 object := d object
  d2 interface :> f interface
  d2 base :> d base
  if (addressof d:path2)=null
    d2 path1 :> d path1
    d2 path2 :> f path
  else
    d2 path1 :> new Str d:path1+d:path2+f:path
    d2 path2 :> null map Str

method dr search d k -> d2
  oarg DataRecord dr ; arg Data_ d ; arg Str k ; arg Data_ d2
  var Pointer:Arrow a :> dr:fields first k
  if a<>null
    (a map DataRecordFieldDef) apply d d2
  else
    d2 := data_null
    d2 base :> d base
    d2 path1 :> new Str d:dbpath+"/"+html_encode:k
    d2 path2 :> null map Str

method dr next d start stop buf -> d2
  oarg DataRecord dr ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2
  var Pointer:Arrow a
  if buf:adr<>null
    a :> dr:all_fields next (buf:adr map Arrow)
  else
    a :> dr:all_fields first
  while a<>null
    var Pointer:DataRecordFieldDef f :> a map DataRecordFieldDef
    if (start:len=0 or html_decode:(f:path 1 f:path:len)>=start) and (stop:len=0 or html_decode:(f:path 1 f:path:len)<stop)
      f apply d d2
      buf adr := addressof a
      return
    a :> dr:all_fields next a
  d2 adr := null

method dr first d start stop buf -> d2
  oarg DataRecord dr ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2
  buf adr := null
  d2 := dr next d start stop buf

method dr count d start stop -> count
  oarg_rw DataRecord dr ; arg Data_ d ; arg Str start stop ; arg Int count
  if start:len=0 and stop:len=0
    count := dr:fields count
  else
    count := 0
    var Pointer:Arrow c :> dr:all_fields first
    while c<>null
      var Pointer:DataRecordFieldDef f :> c map DataRecordFieldDef
      if (start:len=0 or html_decode:(f:path 1 f:path:len)>=start) and (stop:len=0 or html_decode:(f:path 1 f:path:len)<stop)
        count += 1
      c :> dr:all_fields next c

if false
  method dr set d adr type -> status
    oarg_rw DataRecord dr ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status
    if type=Str and (adr map Str)=""
      dr:type destroy_instance d:adr
      dr:type build_instance d:adr
      status := success
    else
      status := failure


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


type DataTable
  field Link:DataInterface_ value_interface
  field Link:Type value_type
  field Link:Type node_type
  
DataInterface_ maybe DataTable


method dt reset d -> status
  oarg_rw DataTable dt ; arg_rw Data_ d ; arg Status status
  var Pointer:Index_ idx :> d:adr map Index_
  idx reset dt:node_type true
  d:base notify_reset d
  status := success


method dt search d k -> d2
  oarg DataTable dt ; arg Data_ d ; arg Str k ; arg Data_ d2
  var Pointer:Index_ idx :> d:adr map Index_
  var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
  if cursor<>null
    d2 adr := cursor
    d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
    d2 interface :> dt value_interface
  else
    d2 := data_null
  d2 base :> d base
  d2 path1 :> new Str d:dbpath+"/"+html_encode:k
  d2 path2 :> null map Str

method dt first d start stop buf -> d2
  oarg DataTable dt ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2
  var Pointer:Index_ idx :> d:adr map Index_
  var Address cursor
  if start:len=0
    cursor := idx first IndexNode_:size+Str:size
  else
    cursor := idx from addressof:start (the_function compare Str Str -> Int) IndexNode_:size+Str:size
  d2 adr := cursor
  if cursor<>null
    d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
    d2 interface :> dt value_interface
    d2 base :> d base
    var Pointer:Str k :> (cursor translate Str -1) map Str
    d2 path1 :> new Str d:dbpath+"/"+html_encode:k
    d2 path2 :> null map Str
    buf adr := cursor

method dt next d start stop buf -> d2
  oarg DataTable dt ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2
  var Pointer:Index_ idx :> d:adr map Index_
  if (idx is_deleted buf:adr IndexNode_:size+Str:size)
    var Str key := (buf:adr translate Str -1) map Str
    # console "automatic recovery of deleted key " key eol
    d2 := dt first d key stop buf
    if d2:adr<>null and d2:key=key
      d2 := dt next d start stop buf
    return
  var Address cursor := idx next buf:adr IndexNode_:size+Str:size
  if cursor=null
    d2 adr := null
    return
  var Pointer:Str k :> (cursor translate Str -1) map Str
  if stop:len>0 and k>=stop
    d2 adr := null
    return
  d2 adr := cursor
  d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
  d2 interface :> dt value_interface
  d2 base :> d base
  var Pointer:Str k :> (cursor translate Str -1) map Str
  d2 path1 :> new Str d:dbpath+"/"+html_encode:k
  d2 path2 :> null map Str
  buf adr := cursor

method dt count d start stop -> count
  oarg_rw DataTable dt ; arg Data_ d ; arg Str start stop ; arg Int count
  var Pointer:Index_ idx :> d:adr map Index_
  if start:len=0 and stop:len=0
    count := idx size
  else
    # highly suboptimal implementation
    count := 0
    var Data_ cur := dt first d start stop (var DataScanBuffer buf)
    while cur:adr<>null
      var Data_ cur := dt next d start stop buf
      count += 1


method dt create d k -> status
  oarg_rw DataTable dt ; arg_rw Data_ d ; arg Str k; arg Status status
  var Pointer:Index_ idx :> d:adr map Index_
  var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
  if cursor=null
    idx insert addressof:k false null (the_function compare Str Str -> Int) Str:size+IndexNode_:size Str dt:value_type dt:node_type true
    d:base notify_create d k
    status := success
  else
    status := failure

method dt delete d k -> status
  oarg_rw DataTable dt ; arg_rw Data_ d ; arg Str k; arg Status status
  var Pointer:Index_ idx :> d:adr map Index_
  var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
  if cursor<>null
    dt:value_interface pre_delete d k
    idx remove cursor IndexNode_:size+Str:size dt:node_type true
    d:base notify_delete d k
    status := success
  else
    status := failure


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


type Anything
  field Str value
  field Index_ index

(addressof:Anything map Type) flags := Anything:flags .or. type_flag_field

type AnythingNode
  field IndexNode_ node
  field Str key
  field Anything value

type DataAnything
  field Link:DataInterface_ value_interface
  field Link:Type value_type
  field Link:Type node_type
  
DataInterface_ maybe DataAnything

function destroy a
  arg_w Anything a
  a:index reset AnythingNode true


method da type d -> t
  oarg DataAnything da ; arg Data_ d ; arg_R Type t
  t :> Str

method da get d adr type -> status
  oarg DataAnything da ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status
  status := from_string adr type (d:adr map Anything):value "db"

method da set d adr type -> status
  oarg_rw DataAnything da ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status
  (d:adr map Anything) value := to_string adr type "db"
  d:base notify_set d d:adr Str
  status := success

method da reset d -> status
  oarg_rw DataAnything da ; arg_rw Data_ d ; arg Status status
  (d:adr map Anything) value := ""
  var Pointer:Index_ idx :> (d:adr map Anything) index
  idx reset AnythingNode true
  d:base notify_reset d
  status := success


method da search d k -> d2
  oarg DataAnything da ; arg Data_ d ; arg Str k ; arg Data_ d2
  var Pointer:Index_ idx :> (d:adr map Anything) index
  var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
  if cursor<>null
    d2 adr := cursor
    d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
    d2 interface :> da
  else
    d2 := data_null
  d2 base :> d base
  d2 path1 :> new Str d:dbpath+"/"+html_encode:k
  d2 path2 :> null map Str

method da first d start stop buf -> d2
  oarg DataAnything da ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2
  var Pointer:Index_ idx :> (d:adr map Anything) index
  var Address cursor
  if start:len=0
    cursor := idx first IndexNode_:size+Str:size
  else
    cursor := idx from addressof:start (the_function compare Str Str -> Int) IndexNode_:size+Str:size
  d2 adr := cursor
  if cursor<>null
    d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
    d2 interface :> da
    d2 base :> d base
    var Pointer:Str k :> (cursor translate Str -1) map Str
    d2 path1 :> new Str d:dbpath+"/"+html_encode:k
    d2 path2 :> null map Str
    buf adr := cursor

method da next d start stop buf -> d2
  oarg DataAnything da ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2
  var Pointer:Index_ idx :> (d:adr map Anything) index
  if (idx is_deleted buf:adr IndexNode_:size+Str:size)
    var Str key := (buf:adr translate Str -1) map Str
    # console "automatic recovery of deleted key " key eol
    d2 := da first d key stop buf
    if d2:adr<>null and d2:key=key
      d2 := da next d start stop buf
    return
  var Address cursor := idx next buf:adr IndexNode_:size+Str:size
  if cursor=null
    d2 adr := null
    return
  var Pointer:Str k :> (cursor translate Str -1) map Str
  if stop:len>0 and k>=stop
    d2 adr := null
    return
  d2 adr := cursor
  d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
  d2 interface :> da
  d2 base :> d base
  var Pointer:Str k :> (cursor translate Str -1) map Str
  d2 path1 :> new Str d:dbpath+"/"+html_encode:k
  d2 path2 :> null map Str
  buf adr := cursor

method da count d start stop -> count
  oarg_rw DataAnything da ; arg Data_ d ; arg Str start stop ; arg Int count
  var Pointer:Index_ idx :> (d:adr map Anything) index
  if start:len=0 and stop:len=0
    count := idx size
  else
    # highly suboptimal implementation
    count := 0
    var Data_ cur := da first d start stop (var DataScanBuffer buf)
    while cur:adr<>null
      var Data_ cur := da next d start stop buf
      count += 1


method da create d k -> status
  oarg_rw DataAnything da ; arg_rw Data_ d ; arg Str k; arg Status status
  var Pointer:Index_ idx :> (d:adr map Anything) index
  var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
  if cursor=null
    idx insert addressof:k false null (the_function compare Str Str -> Int) Str:size+IndexNode_:size Str Anything AnythingNode true
    d:base notify_create d k
    status := success
  else
    status := failure

method da delete d k -> status
  oarg_rw DataAnything da ; arg_rw Data_ d ; arg Str k; arg Status status
  var Pointer:Index_ idx :> (d:adr map Anything) index
  var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
  if cursor<>null
    idx remove cursor IndexNode_:size+Str:size AnythingNode true
    d:base notify_delete d k
    status := success
  else
    status := failure


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

doc
  [The 'interface' function will return an object that implements 'DataInterface_' generic methods, and that will be used to map an object with the type provided as the argument.]


function inmemory_interface t -> di
  arg Type t ; arg Link:DataInterface_ di
  var DataKind k := data_kind t
  if t=Anything
    di :> new DataAnything
  eif k=data_field
    var Link:DataField df :> new DataField
    df type :> t
    di :> df
  eif k=data_record
    var Link:DataRecord dr :> new DataRecord
    dr type :> t
    var (Index Str Arrow) order
    for (var Int i) 0 t:nb_fields-1
      var Link:DataRecordFieldDef f :> new DataRecordFieldDef
      f record_interface :> dr
      f offset := (t field i) offset
      f interface :> data_interface (t field i):type
      f path := "/"+(html_encode (t field i):name)
      f default := (t field i) initial_value
      dr:fields insert (t field i):name false addressof:f
      var Arrow a := addressof f
      order insert (t field i):name a
    var Pointer:Arrow c :> order first
    while addressof:c<>null
      dr:all_fields append c
      c :> order next c
    di :> dr
  eif k=data_set
    var Pointer:Type v :> t value_type
    var Link:DataTable dt :> new DataTable
    dt value_interface :> data_interface v
    dt value_type :> v
    dt node_type :> ('pliant data setnode types' query addressof:v null) map Type
    di :> dt

data_interface_generators append addressof:(the_function inmemory_interface Type -> Link:DataInterface_)