/pliant/language/type/set/list.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  scope "/pliant/language/" "/pliant/install/" 
 17  module "/pliant/install/ring2.pli" 
 18  submodule "common.pli" 
 19   
 20   
 21  type ListNode_ 
 22    field Pointer:ListNode_ next previous 
 23   
 24  method n value -> a 
 25    arg ListNode_ n ; arg Address a 
 26    := addressof:translate ListNode_ 1 
 27   
 28  method n zvalue -> a 
 29    arg ListNode_ n ; arg Address a 
 30    if exists:n 
 31      := addressof:translate ListNode_ 1 
 32    else 
 33      := null 
 34   
 35  method a 'pliant list node' -> n 
 36    arg Address a ; arg_RW ListNode_ n 
 37    :> (translate ListNode_ -1) map ListNode_ 
 38   
 39  method a 'pliant list znode' -> n 
 40    arg Address a ; arg_RW ListNode_ n 
 41    if a<>null 
 42      :> (translate ListNode_ -1) map ListNode_ 
 43    else 
 44      :> null map ListNode_ 
 45   
 46   
 47  type List_ 
 48    field Pointer:ListNode_ first last 
 49   
 50  function build l 
 51    arg_w List_ l 
 52    first :> null map ListNode_ ; last :> null map ListNode_ 
 53   
 54  method l reset valuetype 
 55    arg_w List_ l ; arg Type valuetype 
 56    var Pointer:ListNode_ :> first 
 57    while exists:n 
 58      var Pointer:ListNode_ n2 :> next 
 59      valuetype destroy_instance n:value 
 60      memory_free addressof:n 
 61      :> n2 
 62    first :> null map ListNode_ ; last :> null map ListNode_ 
 63   
 64  method l insert_before p n 
 65    arg_rw List_ l ; arg_rw ListNode_ n 
 66    if exists:p 
 67      previous :> previous 
 68      next :> p 
 69      if (exists p:previous) 
 70        p:previous next :> n 
 71      else 
 72        first :> n 
 73      previous :> n 
 74    else # append = inserts as very last 
 75      previous :> last 
 76      next :> null map ListNode_ 
 77      if (addressof l:last)<>null 
 78        l:last next :> n 
 79      else 
 80        first :> n 
 81      last :> n 
 82   
 83  method l insert_after p n 
 84    arg_rw List_ l ; arg_rw ListNode_ n 
 85    if exists:p 
 86      previous :> p 
 87      next :> next 
 88      if (exists p:next) 
 89        p:next previous :> n 
 90      else 
 91        last :> n 
 92      next :> n 
 93    else # inserts as very first 
 94      previous :> null map ListNode_ 
 95      next :> first 
 96      if (addressof l:first)<>null 
 97        l:first previous :> n 
 98      else 
 99        last :> n 
 100      first :> n 
 101   
 102  method l append n 
 103    arg_rw List_ l ; arg_rw ListNode_ n 
 104    insert_before (null map ListNode_) n 
 105   
 106  method l remove n -> n2 
 107    arg_rw List_ l ; arg_rw ListNode_ n ; arg_RW ListNode_ n2 
 108    if (exists n:next) 
 109      n:next previous :> previous 
 110      n2 :> next 
 111    else 
 112      check (addressof l:last)=addressof:n 
 113      last :> previous 
 114      n2 :> null map ListNode_ 
 115    if (exists n:previous) 
 116      n:previous next :> next 
 117    else 
 118      check (addressof l:first)=addressof:n 
 119      first :> next 
 120   
 121  method l size -> count 
 122    arg List_ l ; arg Int count 
 123    count := 0 
 124    var Pointer:ListNode_ :> first 
 125    while exists:n 
 126      count := count+1 
 127      :> next 
 128   
 129  method l check 
 130    arg List_ l 
 131    if pliant_debugging_level>=2 
 132      var Pointer:ListNode_ n :> l first 
 133      while exists:n 
 134        if (exists n:previous) 
 135          check (addressof n:previous:next)=addressof:n 
 136        else 
 137          check (addressof l:first)=addressof:n 
 138        if (exists n:next) 
 139          check (addressof n:next:previous)=addressof:n 
 140        else 
 141          check (addressof l:last)=addressof:n 
 142        n :> n next 
 143   
 144   
 145  export ListNode_ '. next' '. previous' 
 146  export '. value' '. zvalue' '. pliant list node' '. pliant list znode' 
 147  export List_ '. first' '. last' 
 148  export '. reset' '. insert_before' '. insert_after' '. append' '. remove' 
 149  export '. size' '. check' 
 150   
 151   
 152 
 
 153   
 154   
 155  gvar Relation 'pliant list types' 
 156  export 'pliant list types' 
 157   
 158  function List value -> t 
 159    arg Type value ; arg_R Type t 
 160    has_no_side_effect 
 161   
 162    var Address adr := 'pliant list types' query null addressof:value 
 163    if adr<>null 
 164      return (adr map Type) 
 165   
 166    runtime_compile  Value value  List (cast "(List "+value:name+")" Ident) 
 167   
 168      type List 
 169        field List_ list 
 170   
 171      function destroy l 
 172        arg_w List l 
 173        l:list reset Value 
 174   
 175      method l first -> v 
 176        arg List l ; arg_C Value v 
 177        (addressof Pointer:Value v) map Address := l:list:first zvalue 
 178   
 179      method l last -> v 
 180        arg List l ; arg_C Value v 
 181        (addressof Pointer:Value v) map Address := l:list:last zvalue 
 182   
 183      method l next v1 -> v2 
 184        arg List l ; arg_r Value v1 ; arg_C Value v2 
 185        check (addressof Value v1)<>null 
 186        var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node' 
 187        (addressof Pointer:Value v2) map Address := n:next zvalue 
 188   
 189      method l previous v1 -> v2 
 190        arg List l ; arg_r Value v1 ; arg_C Value v2 
 191        check (addressof Value v1)<>null 
 192        var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node' 
 193        (addressof Pointer:Value v2) map Address := n:previous zvalue 
 194   
 195      method l insert_before v1 v -> v2 
 196        arg_rw List l ; arg_r Value v1 ; arg Value v ; arg_C Value v2 
 197        var Pointer:ListNode_ n :> (memory_allocate ListNode_:size+Value:size addressof:l) map ListNode_ 
 198        Value build_instance n:value 
 199        Value copy_instance (addressof Value v) n:value 
 200        l:list insert_before (addressof Value v1):'pliant list znode' n 
 201        (addressof Pointer:Value v2) map Address := n value 
 202   
 203      method l insert_after v1 v -> v2 
 204        arg_rw List l ; arg_r Value v1 ; arg Value v ; arg_C Value v2 
 205        var Pointer:ListNode_ n :> (memory_allocate ListNode_:size+Value:size addressof:l) map ListNode_ 
 206        Value build_instance n:value 
 207        Value copy_instance (addressof Value v) n:value 
 208        l:list insert_after (addressof Value v1):'pliant list znode' n 
 209        (addressof Pointer:Value v2) map Address := n value 
 210   
 211      method l remove v1 -> v2 
 212        arg_rw List l ; arg_r Value v1 ; arg_C Value v2 
 213        check (addressof Value v1)<>null 
 214        var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node'  
 215        (addressof Pointer:Value v2) map Address := (l:list remove n) zvalue 
 216        Value destroy_instance n:value 
 217        memory_free addressof:n 
 218   
 219      function '+=' l v 
 220        arg_rw List l ; arg Value v 
 221        l insert_before (null map Value) v 
 222   
 223      function '-=' l v 
 224        arg_rw List l ; arg_r Value v 
 225        l remove v 
 226     
 227      method l size -> count 
 228        arg List l ; arg Int count 
 229        count := l:list size 
 230   
 231      method l check 
 232        arg List l 
 233        l:list check 
 234   
 235      function copy src dest 
 236        arg List src ; arg_w List dest 
 237        dest:list reset Value 
 238        var Pointer:ListNode_ n :> src:list first 
 239        while exists:n 
 240          dest += n:value map Value 
 241          n :> n next 
 242   
 243      export List '. first' '. next' '. last' '. previous' '. insert_before' '. insert_after' '. remove' '+=' '-=' '. size' '. check' 
 244      'pliant list types' define null addressof:Value addressof:List 
 245      'pliant set types' define addressof:List addressof:List addressof:(new Str "List") 
 246      'pliant set types' define addressof:List null addressof:Void 
 247      'pliant set types' define null addressof:List addressof:Value 
 248   
 249    var Address adr := 'pliant list types' query null addressof:value 
 250    check adr<>null 
 251    return (adr map Type) 
 252   
 253  export List