a3/code/Generics/_Array.icl

   1 implementation module _Array
   2
   3 import _SystemArray, StdInt, StdClass
   4
   5
   6 createArrayUnsafe :: .Int -> u:(a v:b) | Array a b, [u <= v]
   7 createArrayUnsafe n = _createArray n
   8
   9
  10 instance UnsafeArray {} where
  11         unsafeCreate size =
  12                 code
  13                 {
  14                         create_array_ _ 1 0
  15                 }
  16         unsafeUselect arr index =
  17                 code
  18                 {
  19                         push_a 0
  20                         select _ 1 0
  21                 }
  22
  23 instance UnsafeArray {!} where
  24         unsafeCreate size =
  25                 code
  26                 {
  27                         create_array_ _ 1 0
  28                 }
  29         unsafeUselect arr index =
  30                 code
  31                 {
  32                         push_a 0
  33                         select _ 1 0
  34                 }
  35
  36 //mapArray :: (u:a -> v:b) w:(c u:a) -> x:(d v:b) | UnsafeArray c a & UnsafeArray d b, [w <= u,x <= v]
  37 mapArray :: (u:a -> v:b) w:(c u:a) -> x:(d v:b) | Array d b & UnsafeArray c & UnsafeArray d & Array c a, [w <= u,x <= v]
  38 mapArray f xs
  39         #! (size_xs, xs) = usize xs
  40         #! (xs, ys) = map f 0 size_xs xs (unsafeCreate size_xs)
  41         = ys
  42 where
  43         map f i n xs ys
  44                 | i == n
  45                         = (xs, ys)
  46                 | otherwise
  47                         #! (x, xs) = unsafeUselect xs i
  48                         #! ys = update ys i (f x)
  49                         = map f (inc i) n xs ys
  50
  51 //mapArrayLSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | UnsafeArray d a & UnsafeArray e c, [w <= u,x <= v]
  52 mapArrayLSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | Array e c & UnsafeArray d & UnsafeArray e & Array d a, [w <= u,x <= v]
  53 mapArrayLSt f xs st
  54         #! (size_xs, xs) = usize xs
  55         #! (xs, ys, st) = map f 0 size_xs xs (unsafeCreate size_xs) st
  56         = (ys, st)
  57 where
  58         map f i n xs ys st
  59                 | i == n
  60                         = (xs, ys, st)
  61                 | otherwise
  62                         #! (x, xs) = unsafeUselect xs i
  63                         #! (y, st) = f x st
  64                         #! ys = update ys i y
  65                         = map f (inc i) n xs ys st
  66
  67 //mapArrayRSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | UnsafeArray d a & UnsafeArray e c, [w <= u,x <= v]
  68 mapArrayRSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | Array e c & UnsafeArray d & UnsafeArray e & Array d a, [w <= u,x <= v]
  69 mapArrayRSt f xs st
  70         #! (size_xs, xs) = usize xs
  71         #! (xs, ys, st) = map f (size_xs - 1) xs (unsafeCreate size_xs) st
  72         = (ys, st)
  73 where
  74         map f i xs ys st
  75                 | i < 0
  76                         = (xs, ys, st)
  77                 | otherwise
  78                         #! (x, xs) = unsafeUselect xs i
  79                         #! (y, st) = f x st
  80                         #! ys = update ys i y
  81                         = map f (dec i) xs ys st
  82
  83 reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b .(d c) -> b | Array d c
  84 reduceArray f op e xs
  85         = reduce f 0 (size xs) op e xs
  86 where
  87         reduce f i n op e xs
  88                 | i == n
  89                         = e
  90                 | otherwise
  91                         = op (f op e xs.[i]) (reduce f (inc i) n op e xs)
  92
  93 reduceArrayLSt :: (u:a -> .(.b -> .b)) v:(c u:a) .b -> .b | UnsafeArray c & Array c a, [v <= u]
  94 reduceArrayLSt f xs st
  95         #! (size_xs, xs) = usize xs
  96         #! (xs, st) = reduce f 0 size_xs xs st
  97         = st
  98 where
  99         reduce f i n xs st
 100                 | i == n
 101                         = (xs, st)
 102                 | otherwise
 103                         #! (x, xs) = unsafeUselect xs i
 104                         = reduce f (inc i) n xs (f x st)
 105
 106 reduceArrayRSt :: (u:a -> .(.b -> .b)) v:(c u:a) .b -> .b | UnsafeArray c & Array c a, [v <= u]
 107 reduceArrayRSt f xs st
 108         #! (size_xs, xs) = usize xs
 109         #! (xs, st) = reduce f (dec size_xs) xs st
 110         = st
 111 where
 112         reduce f i xs st
 113                 | i < 0
 114                         = (xs, st)
 115                 | otherwise
 116                         #! (x, xs) = unsafeUselect xs i
 117                         = reduce f (dec i) xs (f x st)