Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/type/set/list.pli
Key:
    Removed line
    Added line
# 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/language/" "/pliant/install/"
module "/pliant/install/ring2.pli"
submodule "common.pli"


type ListNode_
  field Pointer:ListNode_ next previous

method n value -> a
  arg ListNode_ n ; arg Address a
  a := addressof:n translate ListNode_ 1

method n zvalue -> a
  arg ListNode_ n ; arg Address a
  if exists:n
    a := addressof:n translate ListNode_ 1
  else
    a := null

method a 'pliant list node' -> n
  arg Address a ; arg_RW ListNode_ n
  n :> (a translate ListNode_ -1) map ListNode_

method a 'pliant list znode' -> n
  arg Address a ; arg_RW ListNode_ n
  if a<>null
    n :> (a translate ListNode_ -1) map ListNode_
  else
    n :> null map ListNode_


type List_
  field Pointer:ListNode_ first last

function build  l
function build l
  arg_w List_ l
  l first :> null map ListNode_ ; l last :> null map ListNode_

method l reset valuetype
  arg_w List_ l ; arg Type valuetype
  var Pointer:ListNode_ n :> l first
  while exists:n
    var Pointer:ListNode_ n2 :> n next
    valuetype destroy_instance n:value
    memory_free addressof:n
    n :> n2
  l first :> null map ListNode_ ; l last :> null map ListNode_

method l insert_before p n
  arg_rw List_ l ; arg_rw ListNode_ p n
  if exists:p
    n previous :> p previous
    n next :> p
    if (exists p:previous)
      p:previous next :> n
    else
      l first :> n
    p previous :> n
  else # append = inserts as very last
    n previous :> l last
    n next :> null map ListNode_
    if (addressof l:last)<>null
      l:last next :> n
    else
      l first :> n
    l last :> n

method l insert_after p n
  arg_rw List_ l ; arg_rw ListNode_ p n
  if exists:p
    n previous :> p
    n next :> p next
    if (exists p:next)
      p:next previous :> n
    else
      l last :> n
    p next :> n
  else # inserts as very first
    n previous :> null map ListNode_
    n next :> l first
    if (addressof l:first)<>null
      l:first previous :> n
    else
      l last :> n
    l first :> n

method l append n
  arg_rw List_ l ; arg_rw ListNode_ n
  l insert_before (null map ListNode_) n

method l remove n -> n2
  arg_rw List_ l ; arg_rw ListNode_ n ; arg_RW ListNode_ n2
  if (exists n:next)
    n:next previous :> n previous
    n2 :> n next
  else
    check (addressof l:last)=addressof:n
    l last :> n previous
    n2 :> null map ListNode_
  if (exists n:previous)
    n:previous next :> n next
  else
    check (addressof l:first)=addressof:n
    l first :> n next

method l size -> count
  arg List_ l ; arg Int count
  count := 0
  var Pointer:ListNode_ n :> l first
  while exists:n
    count := count+1
    n :> n next

method l check
  arg List_ l
  if pliant_debugging_level>=2
    var Pointer:ListNode_ n :> l first
    while exists:n
      if (exists n:previous)
        check (addressof n:previous:next)=addressof:n
      else
        check (addressof l:first)=addressof:n
      if (exists n:next)
        check (addressof n:next:previous)=addressof:n
      else
        check (addressof l:last)=addressof:n
      n :> n next


export ListNode_ '. next' '. previous'
export '. value' '. zvalue' '. pliant list node' '. pliant list znode'
export List_ '. first' '. last'
export '. reset' '. insert_before' '. insert_after' '. append' '. remove'
export '. size' '. check'


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


gvar Relation 'pliant list types'
export 'pliant list types'

function List value -> t
  arg Type value ; arg_R Type t
  has_no_side_effect

  var Address adr := 'pliant list types' query null addressof:value
  if adr<>null
    return (adr map Type)

  runtime_compile  Value value  List (cast "(List "+value:name+")" Ident)

    type List
      field List_ list

    function destroy l
      arg_w List l
      l:list reset Value

    method l first -> v
      arg List l ; arg_C Value v
      (addressof Pointer:Value v) map Address := l:list:first zvalue

    method l last -> v
      arg List l ; arg_C Value v
      (addressof Pointer:Value v) map Address := l:list:last zvalue

    method l next v1 -> v2
      arg List l ; arg_r Value v1 ; arg_C Value v2
      check (addressof Value v1)<>null
      var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node'
      (addressof Pointer:Value v2) map Address := n:next zvalue

    method l previous v1 -> v2
      arg List l ; arg_r Value v1 ; arg_C Value v2
      check (addressof Value v1)<>null
      var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node'
      (addressof Pointer:Value v2) map Address := n:previous zvalue

    method l insert_before v1 v -> v2
      arg_rw List l ; arg_r Value v1 ; arg Value v ; arg_C Value v2
      var Pointer:ListNode_ n :> (memory_allocate ListNode_:size+Value:size addressof:l) map ListNode_
      Value build_instance n:value
      Value copy_instance (addressof Value v) n:value
      l:list insert_before (addressof Value v1):'pliant list znode' n
      (addressof Pointer:Value v2) map Address := n value

    method l insert_after v1 v -> v2
      arg_rw List l ; arg_r Value v1 ; arg Value v ; arg_C Value v2
      var Pointer:ListNode_ n :> (memory_allocate ListNode_:size+Value:size addressof:l) map ListNode_
      Value build_instance n:value
      Value copy_instance (addressof Value v) n:value
      l:list insert_after (addressof Value v1):'pliant list znode' n
      (addressof Pointer:Value v2) map Address := n value

    method l remove v1 -> v2
      arg_rw List l ; arg_r Value v1 ; arg_C Value v2
      check (addressof Value v1)<>null
      var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node' 
      (addressof Pointer:Value v2) map Address := (l:list remove n) zvalue
      Value destroy_instance n:value
      memory_free addressof:n

    function '+=' l v
      arg_rw List l ; arg Value v
      l insert_before (null map Value) v

    function '-=' l v
      arg_rw List l ; arg_r Value v
      l remove v
  
    method l size -> count
      arg List l ; arg Int count
      count := l:list size

    method l check
      arg List l
      l:list check

    function copy src dest
      arg List src ; arg_w List dest
      dest:list reset Value
      var Pointer:ListNode_ n :> src:list first
      while exists:n
        dest += n:value map Value
        n :> n next

    export List '. first' '. next' '. last' '. previous' '. insert_before' '. insert_after' '. remove' '+=' '-=' '. size' '. check'
    'pliant list types' define null addressof:Value addressof:List
    'pliant set types' define addressof:List addressof:List addressof:(new Str "List")
    'pliant set types' define addressof:List null addressof:Void
    'pliant set types' define null addressof:List addressof:Value

  var Address adr := 'pliant list types' query null addressof:value
  check adr<>null
  return (adr map Type)

export List