Patch title: Release 85 bulk changes
Abstract:
File: /pliant/appli/database/pointer.pli
Key:
    Removed line
    Added line
   
abstract
  [This module will define the 'Data' and 'Database' generic


meta each e
  if e:size<3 or not e:0:is_pure_ident
    return
  var Pointer:Expression filter :> null map Expression
  var Pointer:Expression sort :> null map Expression
  var CBool reversed := false
  var Int i := 2
  while i<e:size-1
    if e:i:ident="filter" and i+1<e:size-1
      filter :> e i+1
      i += 2
    eif e:i:ident="sort" and i+1<e:size-1
      sort :> e i+1
      i += 2
    eif e:i:ident="reversed" and exists:sort
      reversed := true
      i += 1
    else
      return
  e:1 compile ?
  var Pointer:Type set :> e:1:result:type:real_data_type
  if set:category<>"Set"
    return
  var Link:Argument buf :> argument local DataScanBuffer
  var Link:Argument some :> argument local CBool
abstract
  [This module will define the 'Data' and 'Database' generic


meta each e
  if e:size<3 or not e:0:is_pure_ident
    return
  var Pointer:Expression filter :> null map Expression
  var Pointer:Expression sort :> null map Expression
  var CBool reversed := false
  var Int i := 2
  while i<e:size-1
    if e:i:ident="filter" and i+1<e:size-1
      filter :> e i+1
      i += 2
    eif e:i:ident="sort" and i+1<e:size-1
      sort :> e i+1
      i += 2
    eif e:i:ident="reversed" and exists:sort
      reversed := true
      i += 1
    else
      return
  e:1 compile ?
  var Pointer:Type set :> e:1:result:type:real_data_type
  if set:category<>"Set"
    return
  var Link:Argument buf :> argument local DataScanBuffer
  var Link:Argument some :> argument local CBool
  var Link:Argument item :> e local_variable e:0:ident (Data
  var Link:Argument item :> e local_variable e:0 (Data set:value_type)
  if not exists:item
    return
  if addressof:filter<>null and not (filter cast CBool)
    return
  if addressof:sort<>null
    sort compile ?
    var Pointer:Type key :> sort:result:type real_data_type
    if not (sort cast key)
      return
    var Link:Argument idx :> argument local (Index key Data_
    var Link:Argument adr :> argument local Address
    e add (instruction (the_function 'address Universal' Uni
    e add (instruction (the_function '. destroy_instance' Ty
    e add (instruction (the_function '. build_instance' Type
  (e e:size-1) compile ?
  e:1 cast Data:set ; e suckup e:1
  var Link:Instruction next :> instruction the_function:'do 
  var Link:Instruction end :> instruction the_function:'do n
  e add (instruction (the_function scan_first Data_ Data_ Da
  e add (instruction (the_function 'jump if not' CBool) some
  var Link:Instruction body :> instruction the_function:'do 
  e add body
  if addressof:filter<>null
    e suckup filter
    e add (instruction (the_function 'jump if not' CBool) fi
  if addressof:sort=null
    e suckup (e e:size-1)
  else
    e suckup sort
    var Link:Function f :>pick_function ". insert" (Index ke
    e add (instruction f idx sort:result item (argument indi
  if addressof:filter<>null
    e add next
  e add (instruction (the_function scan_next Data_ Data_ Dat
  e add (instruction (the_function 'jump if' CBool) some jum
  e add end
  if addressof:sort<>null
    var Link:Argument ptr :> argument local Address
    var Link:Argument cursor :> argument indirect Data_ ptr 
    var Link:Argument cond :> argument local CBool
    var Link:Instruction stop :> instruction the_function:'d
    var Link:Function f :> pick_function (shunt reversed ". 
    e add (instruction f idx cursor)
    e add (instruction (the_function is_null Address -> CBoo
    e add (instruction (the_function 'jump if' CBool) cond j
    var Link:Instruction again :> instruction the_function:'
    e add again
    e add (instruction (the_function 'copy Universal' Univer
    e suckup (e e:size-1)
    var Link:Function f :>pick_function (shunt reversed ". p
    e add (instruction f idx cursor cursor)
    e add (instruction (the_function is_null Address -> CBoo
    e add (instruction (the_function 'jump if not' CBool) co
    e add stop
  e set_void_result



export ':>' ':=' '' '. size' '. create' '. delete' keyof pat
export '. pmap' data_reset data_copy
export each
  if not exists:item
    return
  if addressof:filter<>null and not (filter cast CBool)
    return
  if addressof:sort<>null
    sort compile ?
    var Pointer:Type key :> sort:result:type real_data_type
    if not (sort cast key)
      return
    var Link:Argument idx :> argument local (Index key Data_
    var Link:Argument adr :> argument local Address
    e add (instruction (the_function 'address Universal' Uni
    e add (instruction (the_function '. destroy_instance' Ty
    e add (instruction (the_function '. build_instance' Type
  (e e:size-1) compile ?
  e:1 cast Data:set ; e suckup e:1
  var Link:Instruction next :> instruction the_function:'do 
  var Link:Instruction end :> instruction the_function:'do n
  e add (instruction (the_function scan_first Data_ Data_ Da
  e add (instruction (the_function 'jump if not' CBool) some
  var Link:Instruction body :> instruction the_function:'do 
  e add body
  if addressof:filter<>null
    e suckup filter
    e add (instruction (the_function 'jump if not' CBool) fi
  if addressof:sort=null
    e suckup (e e:size-1)
  else
    e suckup sort
    var Link:Function f :>pick_function ". insert" (Index ke
    e add (instruction f idx sort:result item (argument indi
  if addressof:filter<>null
    e add next
  e add (instruction (the_function scan_next Data_ Data_ Dat
  e add (instruction (the_function 'jump if' CBool) some jum
  e add end
  if addressof:sort<>null
    var Link:Argument ptr :> argument local Address
    var Link:Argument cursor :> argument indirect Data_ ptr 
    var Link:Argument cond :> argument local CBool
    var Link:Instruction stop :> instruction the_function:'d
    var Link:Function f :> pick_function (shunt reversed ". 
    e add (instruction f idx cursor)
    e add (instruction (the_function is_null Address -> CBoo
    e add (instruction (the_function 'jump if' CBool) cond j
    var Link:Instruction again :> instruction the_function:'
    e add again
    e add (instruction (the_function 'copy Universal' Univer
    e suckup (e e:size-1)
    var Link:Function f :>pick_function (shunt reversed ". p
    e add (instruction f idx cursor cursor)
    e add (instruction (the_function is_null Address -> CBoo
    e add (instruction (the_function 'jump if not' CBool) co
    e add stop
  e set_void_result



export ':>' ':=' '' '. size' '. create' '. delete' keyof pat
export '. pmap' data_reset data_copy
export each