Add Unfoldable and Tabulatable, two constructing classes

library/classes.lisp

@@ -26,6 +26,8 @@
    #:MonadFail #:fail
    #:Alternative #:alt #:empty
    #:Foldable #:fold #:foldr #:mconcat #:mconcatmap
+   #:Unfoldable #:unfold #:unfoldr
+   #:Tabulatable #:tabulate
    #:mempty? #:mcommute?
    #:Traversable #:traverse
    #:Bifunctor #:bimap #:map-fst #:map-snd
@@ -261,6 +263,16 @@ together."
     (fold  "A left tail-recursive fold."       ((:accum -> :elt -> :accum) -> :accum -> :container :elt -> :accum))
     (foldr "A right non-tail-recursive fold."  ((:elt -> :accum -> :accum) -> :accum -> :container :elt -> :accum)))
 
+  (define-class (Unfoldable :container :elt)
+    "Types of containers that can be constructed from a seed value and a generator function."
+    (unfold  "A left unfold.  Elements are generated toward left."      ((:seed -> Optional (Tuple :seed :elt)) -> :seed -> :container :elt))
+    (unfoldr "A right unfold.  Elements are generated toward right." ((:seed -> Optional (Tuple :elt :seed)) -> :seed -> :container :elt)))
+
+  (define-class (Tabulatable :container :elt)
+    "Types of containers that can be constructed from index of each element."
+    (tabulate "Construct a container whose i-th element is computed from i"
+              ((UFix -> :elt) -> UFix -> :container :elt)))
+
   (declare mempty? ((Eq :a) (Monoid :a) => :a -> Boolean))
   (define (mempty? a)
     "Does `a` equal `(the Type mempty)`?"

library/hashtable.lisp

@@ -153,7 +153,7 @@
               (cl:if presentp
                      (Some value)
                      None))))
-      (with-default 0 (the (Result String UFix) (tryinto (count table)))))) 
+      (with-default 0 (the (Result String UFix) (tryinto (count table))))))
 
   (declare extend! ((Hash :key) (iter:IntoIterator :container (Tuple :key :value))
                    => Hashtable :key :value -> :container -> Unit))
@@ -174,7 +174,7 @@
     (define (== ht1 ht2)
       (unless (== (count ht1) (count ht2))
         (return False))
-      
+
       (iter:every!
        (fn (key)
          (== (get ht1 key) (get ht2 key)))

library/lisparray.lisp

@@ -5,7 +5,8 @@
 (coalton-library/utils:defstdlib-package #:coalton-library/lisparray
   (:use
    #:coalton
-   #:coalton-library/classes)
+   #:coalton-library/classes
+   #:coalton-library/experimental/loops)
   (:local-nicknames
    (#:types #:coalton-library/types)
    (#:complex #:coalton-library/math/complex))
@@ -94,6 +95,15 @@ WARNING: The consequences are undefined if an uninitialized element is read befo
     (lisp (LispArray :t) (v)
       (cl:copy-seq v)))
 
+  (define-instance (Eq :a => Eq (LispArray :a))
+    (define (== a b)
+      (let ((len (length a)))
+        (and (== len (length b))
+             (rec % ((i 0))
+               (cond ((== i len) True)
+                     ((== (aref a i) (aref b i)) (% (+ i 1)))
+                     (True False)))))))
+
   (define-instance (types:RuntimeRepr :t => Into (List :t) (LispArray :t))
     (inline)
     (define (into xs)
@@ -134,6 +144,29 @@ WARNING: The consequences are undefined if an uninitialized element is read befo
                (f (aref v 0) acc)
                (% (- i 1) (f (aref v i) acc))))))))
 
+  ;; Unfolding is an inefficient way to build LispArray, but it comes handy
+  ;; to synthesize data with various aggregate types in a generic code.
+  (define-instance (types:RuntimeRepr :t => Unfoldable LispArray :t)
+    (define (unfold proc seed)
+      (rec next ((seed seed)
+                 (elts Nil))
+          (match (proc seed)
+            ((None) (as (LispArray :t) elts))
+            ((Some (Tuple seed x)) (next seed (Cons x elts))))))
+    (define (unfoldr proc seed)
+      (as (LispArray :t)
+          (rec next ((seed seed))
+            (match (proc seed)
+              ((None) Nil)
+              ((Some (Tuple x seed)) (Cons x (next seed))))))))
+
+  (define-instance (types:RuntimeRepr :t => Tabulatable LispArray :t)
+    (define (tabulate f len)
+      (let ((arr (make-uninitialized len)))
+        (dotimes (i len)
+          (set! arr i (f i)))
+        arr)))
+
   (lisp-toplevel ()
     (cl:eval-when (:compile-toplevel :load-toplevel)
       (cl:defmacro define-lisparray-specialization (coalton-type lisp-type)
@@ -186,4 +219,3 @@ WARNING: The consequences are undefined if an uninitialized element is read befo
 
 #+sb-package-locks
 (sb-ext:lock-package "COALTON-LIBRARY/LISPARRAY")
-

library/list.lisp

@@ -257,12 +257,12 @@
   (define (nth-cdr n l)
     "Returns the nth-cdr of a list."
     (cond ((null? l)
-	   Nil)
-	  ((math:zero? n)
-	   l)
-	  (True
-	   (nth-cdr (math:1- n) (cdr l)))))
-  
+           Nil)
+          ((math:zero? n)
+           l)
+          (True
+           (nth-cdr (math:1- n) (cdr l)))))
+
   (declare elemIndex (Eq :a => :a -> List :a -> Optional UFix))
   (define (elemIndex x xs)
     (findIndex (== x) xs))
@@ -758,6 +758,26 @@ This function is equivalent to all size-N elements of `(COMBS L)`."
         ((Cons x xs) (liftA2 Cons (f x) (traverse f xs)))
         ((Nil) (pure Nil)))))
 
+  (define-instance (Unfoldable List :t)
+    (define (unfold f seed)
+      (rec next ((seed seed)
+                 (xs Nil))
+        (match (f seed)
+          ((None) xs)
+          ((Some (Tuple seed x)) (next seed (Cons x xs))))))
+    (define (unfoldr f seed)
+      (match (f seed)
+        ((None) Nil)
+        ((Some (Tuple x seed)) (Cons x (unfoldr f seed))))))
+
+  (define-instance (Tabulatable List :t)
+    (define (tabulate f len)
+      (rec next ((k len)
+                 (r Nil))
+        (if (== k 0)
+            r
+            (next (- k 1) (Cons (f (- k 1)) r))))))
+
   (define-instance (iter:IntoIterator (List :elt) :elt)
     (define (iter:into-iter list)
       (let remaining = (cell:new list))