utils: Add vlist-ref* and list->vlist*.

* sly/utils.scm (vlist-ref*, list->vlist*): New procedures.
* doc/api/utils.texi: Document them.

2 files changed, 30 insertions, 2 deletions

diff --git a/doc/api/utils.texi b/doc/api/utils.texi
index 308daee..4858010 100644
--- a/doc/api/utils.texi
+++ b/doc/api/utils.texi
@@ -72,7 +72,7 @@ an object within the guardian is GC'd.  Reaping is ensured to happen
 from the same thread that is running the game loop.
 @end deffn
 
-@deffn memoize @var{proc}
+@deffn {Scheme Procedure} memoize @var{proc}
 Return a memoizing version of @code{proc}.
 @end deffn
 
@@ -108,3 +108,12 @@ Like @code{chain*} but for a single argument.
 @end example
 
 @end deffn
+
+@deffn {Scheme Procedure} list->vlist* @var{lst}
+Convert @code{lst} and all sub-lists within to vlists.
+@end deffn
+
+@deffn {Scheme Procedure} list->vlist* @var{lst} @var{index} [@dots{}]
+Return the element at index @code{index @dots{}} in the nested vlist
+structure @code{vlist}.
+@end deffn
diff --git a/sly/utils.scm b/sly/utils.scm
index 7256ab6..0e38fe4 100644
--- a/sly/utils.scm
+++ b/sly/utils.scm
@@ -23,6 +23,8 @@
 ;;; Code:
 
 (define-module (sly utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (rnrs arithmetic bitwise)
   #:use-module (sly agenda)
@@ -30,7 +32,8 @@
             memoize
             forever
             trampoline
-            chain* chain))
+            chain* chain
+            list->vlist* vlist-ref*))
 
 (define-syntax-rule (define-guardian name reaper)
   "Define a new guardian called NAME and call REAPER when an object
@@ -78,3 +81,19 @@ same thread that is running the game loop."
 
 (define-syntax-rule (chain arg (proc ...) . rest)
   (chain* (list arg) (proc ...) . rest))
+
+(define (list->vlist* lst)
+  "Convert LST and all sub-lists within to vlists."
+  (list->vlist
+   (map (match-lambda
+         ((sub-lst ...)
+          (list->vlist* sub-lst))
+         (obj obj))
+        lst)))
+
+(define (vlist-ref* vlist index . rest)
+  "Return the element at index INDEX ... in the nested vlist structure
+VLIST."
+  (if (null? rest)
+      (vlist-ref vlist index)
+      (apply vlist-ref* (vlist-ref vlist index) rest)))