Patch title: Release 94 bulk changes
Abstract:
File: /pliant/language/type/set/relation.pli
Key:
    Removed line
    Added line
scope "/pliant/language/" "/pliant/install/"
module "/pliant/install/ring2.pli"


type Any
  void

method r scan_forward t index n item -> some
  arg Relation r ; arg Type t ; arg_rw Int index ; arg Address n ; arg_rw Pointer:Arrow item ; arg CBool some
  var Address node := n
  while true
    if node=null
      index += 1
      if index>=r:hashsize
        return false
      else
        node := ((addressof:r map Address) translate Address index) map Address
    else
      item :> (node translate Address 3) map Arrow
      if t<>Any and entry_type:item<>t
        node := node map Address
      else  
        return true
  some := false
  
method r scan_first t index item -> some
  arg Relation r ; arg Type t ; arg_rw Int index ; arg_rw Pointer:Arrow item ; arg CBool some
  if r:hashsize=0
    return false
  index := 0
  var Address node := (addressof:r map Address) map Address
  some := r scan_forward t index node item
  
method r scan_next t index item -> some
  arg Relation r ; arg Type t ; arg_rw Int index ; arg_rw Pointer:Arrow item ; arg CBool some
  var Address node := addressof:item translate Arrow -3
  node := node map Address
  some := r scan_forward t index node item
  
function relation_item_addresses item adr1 adr2
  arg Pointer:Arrow item ; arg_w Address adr1 adr2
  adr1 := (addressof:item translate Address -2) map Address
  adr2 := (addressof:item translate Address -1) map Address

meta each e
  if e:size<3 or not e:0:is_pure_ident or not (e:1 cast Relation)
    return
  var Pointer:Arrow c :> pliant_general_dictionary first "pliant function"
  if c=null or entry_type:c<>Function
    return
  var Link:Function current_function :> c map Function
  var Link:Expression key1 :> null map Expression
  var Link:Expression key2 :> null map Expression
  var Link:Type t :> Any
  var Int i := 2
  while i<e:size-1
    if i+1<e:size and e:i:ident="type" and (e:(i+1) constant Type)<>null
      t :> (e:(i+1) constant Type) map Type
      i += 2
    eif i+2<e:size and e:i:ident="getkeys" and e:(i+1):is_pure_ident and e:(i+2):is_pure_ident
      key1 :> e i+1
      key2 :> e i+2
      i += 3
    else
      return
  var Link:Argument index :> argument local Int
  var Link:Argument arrow :> argument local Pointer:Arrow
  if t=Any
    arrow :> argument local Pointer:Arrow
  else
    arrow :> argument local (pointerto linkto:t)
  var Link:Argument some :> argument local CBool
  var Link:LocalVariable lv :> new LocalVariable
  lv name := e:0 ident
  lv body :> arrow
  lv access := access_read+access_write
  lv function :> null map Function
  lv function :> current_function
  e define lv:name addressof:lv e:module
  e suckup e:1
  var Link:Instruction end :> instruction the_function:'do nothing'
  e add (instruction (the_function '. scan_first' Relation Type Int Pointer:Arrow -> CBool) e:1:result (argument mapped_constant Type t) index arrow some)
  e add (instruction (the_function 'jump if not' CBool) some jump end)
  var Link:Instruction body :> instruction the_function:'do nothing'
  e add body
  if addressof:key1<>null
    var Link:Argument adr1 :> argument local Address
    var Link:LocalVariable lv1 :> new LocalVariable
    lv1 name := key1 ident
    lv1 body :> adr1
    lv1 access := access_read
    lv1 function :> current_function
    e define lv1:name addressof:lv1 e:module
    var Link:Argument adr2 :> argument local Address
    var Link:LocalVariable lv2 :> new LocalVariable
    lv2 name := key2 ident
    lv2 body :> adr2
    lv2 access := access_read
    lv2 function :> current_function
    e define lv2:name addressof:lv2 e:module
    e add (instruction (the_function relation_item_addresses Pointer:Arrow Address Address) arrow adr1 adr2)
  (e e:size-1) compile ?
  e suckup (e e:size-1)
  e add (instruction (the_function '. scan_next' Relation Type Int Pointer:Arrow -> CBool) e:1:result (argument mapped_constant Type t) index arrow some)
  e add (instruction (the_function 'jump if' CBool) some jump body)
  e add end 
  e set_void_result

export each