reset a3, kut Charlie ;)

[tt2015.git] / a3 / code / Generics / _Array.icl

diff --git a/a3/code/Generics/_Array.icl b/a3/code/Generics/_Array.icl
new file mode 100644 (file)
index 0000000..dbff74a
--- /dev/null
+++ b/a3/code/Generics/_Array.icl
@@ -0,0 +1,117 @@
+implementation module _Array\r
+\r
+import _SystemArray, StdInt, StdClass\r
+\r
+\r
+createArrayUnsafe :: .Int -> u:(a v:b) | Array a b, [u <= v]\r
+createArrayUnsafe n = _createArray n\r
+\r
+\r
+instance UnsafeArray {} where \r
+       unsafeCreate size =\r
+               code\r
+               {       \r
+                       create_array_ _ 1 0\r
+               }\r
+       unsafeUselect arr index =\r
+               code\r
+               {\r
+                       push_a 0\r
+                       select _ 1 0\r
+               }\r
+\r
+instance UnsafeArray {!} where \r
+       unsafeCreate size =\r
+               code\r
+               {       \r
+                       create_array_ _ 1 0\r
+               }\r
+       unsafeUselect arr index =\r
+               code\r
+               {\r
+                       push_a 0\r
+                       select _ 1 0\r
+               }\r
+\r
+//mapArray :: (u:a -> v:b) w:(c u:a) -> x:(d v:b) | UnsafeArray c a & UnsafeArray d b, [w <= u,x <= v]\r
+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]\r
+mapArray f xs\r
+       #! (size_xs, xs) = usize xs\r
+       #! (xs, ys) = map f 0 size_xs xs (unsafeCreate size_xs)\r
+       = ys\r
+where\r
+       map f i n xs ys\r
+               | i == n        \r
+                       = (xs, ys)\r
+               | otherwise\r
+                       #! (x, xs) = unsafeUselect xs i\r
+                       #! ys = update ys i (f x) \r
+                       = map f (inc i) n xs ys \r
+\r
+//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]\r
+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]\r
+mapArrayLSt f xs st\r
+       #! (size_xs, xs) = usize xs\r
+       #! (xs, ys, st) = map f 0 size_xs xs (unsafeCreate size_xs) st\r
+       = (ys, st)\r
+where\r
+       map f i n xs ys st\r
+               | i == n        \r
+                       = (xs, ys, st)\r
+               | otherwise\r
+                       #! (x, xs) = unsafeUselect xs i\r
+                       #! (y, st) = f x st\r
+                       #! ys = update ys i y \r
+                       = map f (inc i) n xs ys st\r
+\r
+//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]\r
+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]\r
+mapArrayRSt f xs st\r
+       #! (size_xs, xs) = usize xs\r
+       #! (xs, ys, st) = map f (size_xs - 1) xs (unsafeCreate size_xs) st\r
+       = (ys, st)\r
+where\r
+       map f i xs ys st\r
+               | i < 0 \r
+                       = (xs, ys, st)\r
+               | otherwise\r
+                       #! (x, xs) = unsafeUselect xs i\r
+                       #! (y, st) = f x st\r
+                       #! ys = update ys i y \r
+                       = map f (dec i) xs ys st\r
+\r
+reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b .(d c) -> b | Array d c\r
+reduceArray f op e xs \r
+       = reduce f 0 (size xs) op e xs\r
+where\r
+       reduce f i n op e xs\r
+               | i == n \r
+                       = e\r
+               | otherwise\r
+                       = op (f op e xs.[i]) (reduce f (inc i) n op e xs) \r
+\r
+reduceArrayLSt :: (u:a -> .(.b -> .b)) v:(c u:a) .b -> .b | UnsafeArray c & Array c a, [v <= u]\r
+reduceArrayLSt f xs st\r
+       #! (size_xs, xs) = usize xs\r
+       #! (xs, st) = reduce f 0 size_xs xs st\r
+       = st\r
+where\r
+       reduce f i n xs st\r
+               | i == n        \r
+                       = (xs, st)\r
+               | otherwise\r
+                       #! (x, xs) = unsafeUselect xs i\r
+                       = reduce f (inc i) n xs (f x st)\r
+\r
+reduceArrayRSt :: (u:a -> .(.b -> .b)) v:(c u:a) .b -> .b | UnsafeArray c & Array c a, [v <= u]\r
+reduceArrayRSt f xs st\r
+       #! (size_xs, xs) = usize xs\r
+       #! (xs, st) = reduce f (dec size_xs) xs st\r
+       = st\r
+where\r
+       reduce f i xs st\r
+               | i < 0\r
+                       = (xs, st)\r
+               | otherwise\r
+                       #! (x, xs) = unsafeUselect xs i\r
+                       = reduce f (dec i) xs (f x st)\r