add instances for unboxed arrays

src/Data/Array/Unboxed.dcl

@@ -14,32 +14,32 @@ import _SystemArray
 
 /// # Instances
 
-// instance Show {#Bool}
+instance Show {#Bool}
 instance Show {#Char}
 // instance Show {#Nat}
-// instance Show {#Int}
-// instance Show {#Real}
+instance Show {#Int}
+instance Show {#Real}
 
-// instance Eq {#Bool}
+instance Eq {#Bool}
 instance Eq {#Char}
 // instance Eq {#Nat}
-// instance Eq {#Int}
-// instance Eq {#Real}
+instance Eq {#Int}
+instance Eq {#Real}
 
-// instance Ord {#Bool}
+instance Ord {#Bool}
 instance Ord {#Char}
 // instance Ord {#Nat}
-// instance Ord {#Int}
-// instance Ord {#Real}
+instance Ord {#Int}
+instance Ord {#Real}
 
-// instance Semigroup {#Bool}
+instance Semigroup {#Bool}
 instance Semigroup {#Char}
 // instance Semigroup {#Nat}
-// instance Semigroup {#Int}
-// instance Semigroup {#Real}
+instance Semigroup {#Int}
+instance Semigroup {#Real}
 
-// instance Monoid {#Bool}
+instance Monoid {#Bool}
 instance Monoid {#Char}
 // instance Monoid {#Nat}
-// instance Monoid {#Int}
-// instance Monoid {#Real}
+instance Monoid {#Int}
+instance Monoid {#Real}

src/Data/Array/Unboxed.icl

 implementation module Data.Array.Unboxed
 
-import Data.Function
+import Data.Bool
+// import Data.Nat
+import Data.Int
+import Data.Real
+import Data.Enum
 
 import Algebra.Order
 import Algebra.Group
@@ -11,34 +15,55 @@ import _SystemArray
 
 /// ## Instances
 
+instance Show {#Bool} where
+    show xs = showUnboxedArray xs
 instance Show {#Char} where
     show xs = code inline {
         no_op
     }
-
-// instance Eq {#Bool} where
-//     (==) xs ys = inline_equal xs ys
-
+// instance Show {#Nat} where
+    // show xs = showUnboxedArray xs
+instance Show {#Int} where
+    show xs = showUnboxedArray xs
+instance Show {#Real} where
+    show xs = showUnboxedArray xs
+
+// showUnboxedArray :: {#a} -> String | Show a
+showUnboxedArray xs
+    | size xs == 0 :== "{#}"
+    | otherwise    :== "{#" + show xs.[0] + go 1
+where
+    go i
+        | i < size xs = "," + show xs.[i] + go (succ i)
+        | otherwise   = "}"
+
+instance Eq {#Bool} where
+    (==) xs ys = eqUnboxedArray xs ys
 instance Eq {#Char} where
     (==) xs ys = code inline {
         .d 2 0
             jsr eqAC
         .o 0 1 b
     }
-
 // instance Eq {#Nat} where
-//     (==) xs ys = inline_equal xs ys
-
-// instance Eq {#Int} where
-//     (==) xs ys = inline_equal xs ys
-
-// instance Eq {#Real} where
-//     (==) xs ys = inline_equal xs ys
-
-
-// instance Ord {#Bool} where
-//     (<) xs ys = inline_lesser xs ys
-
+    // (==) xs ys = eqUnboxedArray xs ys
+instance Eq {#Int} where
+    (==) xs ys = eqUnboxedArray xs ys
+instance Eq {#Real} where
+    (==) xs ys = eqUnboxedArray xs ys
+
+// eqUnboxedArray :: {#a} {#a} -> Bool | Eq a
+eqUnboxedArray xs ys
+    | size xs /= size ys :== False
+    | size xs == 0       :== True
+    | otherwise          :== go 0
+where
+    go i
+        | i < size xs = xs.[i] == ys.[i] && go (succ i)
+        | otherwise   = True
+
+instance Ord {#Bool} where
+    (<) xs ys = ltUnboxedArray xs ys
 instance Ord {#Char} where
     (<) xs ys = code inline {
         .d 2 0
@@ -47,48 +72,58 @@ instance Ord {#Char} where
             pushI 0
             gtI
     }
-
 // instance Ord {#Nat} where
-//     (<) xs ys = inline_lesser xs ys
-
-// instance Ord {#Int} where
-//     (<) xs ys = inline_lesser xs ys
-
-// instance Ord {#Real} where
-//     (<) xs ys = inline_lesser xs ys
-
-
-// instance Semigroup {#Bool} where
-//     (+) xs ys = inline_append xs ys
-
+    // (<) xs ys = ltUnboxedArray xs ys
+instance Ord {#Int} where
+    (<) xs ys = ltUnboxedArray xs ys
+instance Ord {#Real} where
+    (<) xs ys = ltUnboxedArray xs ys
+
+// ltUnboxedArray :: {#a} {#a} -> Bool | Ord a
+ltUnboxedArray xs ys
+    | size xs > size ys :== False
+    | otherwise         :== go 0
+where
+    go i
+        | i < size xs
+            | xs.[i] <  ys.[i] = True
+            | xs.[i] == ys.[i] = go (succ i)
+            | otherwise        = False
+        | otherwise = size xs < size ys
+
+instance Semigroup {#Bool} where
+    (+) xs ys = concatUnboxedArray xs ys
 instance Semigroup {#Char} where
     (+) xs ys = code inline {
         .d 2 0
             jsr catAC
         .o 1 0
     }
-
 // instance Semigroup {#Nat} where
-//     (+) xs ys = inline_append xs ys
-
-// instance Semigroup {#Int} where
-//     (+) xs ys = inline_append xs ys
-
-// instance Semigroup {#Real} where
-//     (+) xs ys = inline_append xs ys
-
-
-// instance Monoid {#Bool} where
-//     neutral = {# }
-
+    // (+) xs ys = concatUnboxedArray xs ys
+instance Semigroup {#Int} where
+    (+) xs ys = concatUnboxedArray xs ys
+instance Semigroup {#Real} where
+    (+) xs ys = concatUnboxedArray xs ys
+
+// concatUnboxedArray :: {#a} {#a} -> {#a}
+concatUnboxedArray xs ys #
+    // new = array (size xs + size ys) neutral
+    new = unsafeArray (size xs + size ys)
+    new = { new & [i]           = xs.[i] \\ i <- [0..pred (size xs)] }
+    new = { new & [i + size xs] = ys.[i] \\ i <- [0..pred (size ys)] }
+:== new
+
+instance Monoid {#Bool} where
+    neutral = emptyUnboxedArray
 instance Monoid {#Char} where
-    neutral = "" //TODO primitive ABC code?
-
+    neutral = emptyUnboxedArray
 // instance Monoid {#Nat} where
-//     neutral = {# }
-
-// instance Monoid {#Int} where
-//     neutral = {# }
-
-// instance Monoid {#Real} where
-//     neutral = {# }
+    // neutral = emptyUnboxedArray
+instance Monoid {#Int} where
+    neutral = emptyUnboxedArray
+instance Monoid {#Real} where
+    neutral = emptyUnboxedArray
+
+// emptyUnboxedArray :: {#a}
+emptyUnboxedArray = {# }