/pliant/language/type/set/array.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 "/pliant/language/basic/setfield.pli" 
 19  submodule "common.pli" 
 20   
 21   
 22  gvar Relation 'pliant array types' 
 23  export 'pliant array types' 
 24   
 25  function Array value -> t 
 26    arg Type value ; arg_R Type t 
 27    has_no_side_effect 
 28   
 29    var Address adr := 'pliant array types' query addressof:value null 
 30    if adr<>null 
 31      return (adr map Type) 
 32   
 33    runtime_compile  Value value  Array (cast "(Array "+value:name+")" Ident) 
 34      type Array 
 35        field Address items 
 36        field Int nb 
 37   
 38      function build  a 
 39        arg_w Array a 
 40        a items := null 
 41        a nb := 0 
 42   
 43      function destroy a 
 44        arg_w Array a 
 45        if (Value:flags .and. type_flag_scalar)=0 
 46          for (var Int i) 0 a:nb-1 
 47            Value destroy_instance (a:items translate Value i) 
 48        memory_free a:items 
 49   
 50      method a '' k -> v 
 51        arg Array a ; arg Int k ; arg_C Value v 
 52        check k>=0 and k<a:nb "out of range array index" 
 53        # v :> (a:items translate Value k) map Value 
 54        (addressof Pointer:Value v) map Address := a:items translate Value k 
 55   
 56      method a size -> n 
 57        arg Array a ; arg Int n 
 58        n := a nb 
 59   
 60      method a 'size :=' s 
 61        arg_rw Array a ; arg Int s 
 62        check s>=0 "negative array size" 
 63        if s>a:nb 
 64          a items := memory_resize a:items s*Value:size addressof:a 
 65          if (Value:flags .and. type_flag_scalar)=0 
 66            for (var Int i) a:nb s-1 
 67              Value build_instance (a:items translate Value i) 
 68        if s<a:nb 
 69          if (Value:flags .and. type_flag_scalar)=0 
 70            for (var Int i) s a:nb-1 
 71              Value destroy_instance (a:items translate Value i) 
 72          a items := memory_resize a:items s*Value:size addressof:a 
 73        a nb := s 
 74   
 75      function copy src dest 
 76        arg Array src ; arg_w Array dest 
 77        dest 'size :=' src:nb 
 78        if (Value:flags .and. type_flag_scalar)=0 
 79          for (var Int i) 0 src:nb-1 
 80            # dest i := src i 
 81            Value copy_instance (src:items translate Value i) (dest:items translate Value i) 
 82        else 
 83          memory_copy src:items dest:items src:nb*Value:size 
 84   
 85      function '+=' a v 
 86        arg_rw Array a ; arg Value v 
 87        var Int i := a size 
 88        a 'size :=' i+1 
 89        # a i := v 
 90        Value copy_instance (addressof Value v) (a:items translate Value i) 
 91   
 92      method a exists k -> c 
 93        arg Array a ; arg Int k ; arg CBool c 
 94        c := k>=0 and k<a:size 
 95   
 96      method a key v -> k 
 97        arg Array a ; arg_r Value v ; arg Int k 
 98        k := ( (cast (addressof Value v) Int) .-. (cast a:items Int) ) \ Value:size 
 99   
 100      method a first -> v 
 101        arg Array a ; arg_C Value v 
 102        if a:size>0 
 103          # v :> a 0 
 104          (addressof Pointer:Value v) map Address := a items 
 105        else 
 106          # v :> null map Value 
 107          (addressof Pointer:Value v) map Address := null 
 108   
 109      method a next v1 -> v2 
 110        arg Array a ; arg_r Value v1 ; arg_C Value v2 
 111        var Int i := (a key v1)+1 
 112        if a:size>i 
 113          # v2 :> a i 
 114          (addressof Pointer:Value v2) map Address := a:items translate Value i 
 115        else 
 116          # v2 :> null map Value 
 117          (addressof Pointer:Value v2) map Address := null 
 118   
 119      method a first k -> v 
 120        arg Array a ; arg Int k ; arg_C Value v 
 121        if k>=0 and k<a:size 
 122          # v :> a k 
 123          (addressof Pointer:Value v) map Address := a:items translate Value k 
 124        else 
 125          # v :> null map Value 
 126          (addressof Pointer:Value v) map Address := null 
 127   
 128      method a next k v1 -> v2 
 129        arg Array a; arg Int k ; arg_r Value v1 ; arg_C Value v2 
 130        # v2 :> null map Value 
 131        (addressof Pointer:Value v2) map Address := null 
 132   
 133      method a check 
 134        arg Array a 
 135   
 136      export Array '' '. size' '. size :=' '+=' '. exists' '. key' '. first' '. next' '. check' 
 137      'pliant array types' define addressof:Value null addressof:Array 
 138      'pliant set types' define addressof:Array addressof:Array addressof:(new Str "Array") 
 139      'pliant set types' define addressof:Array null addressof:Int 
 140      'pliant set types' define null addressof:Array addressof:Value 
 141   
 142    var Address adr := 'pliant array types' query addressof:value null 
 143    check adr<>null 
 144    return (adr map Type) 
 145   
 146  export Array 
 147