argyle/base/io.scm

@@ -1,7 +1,9 @@
 (ns (argyle base io)
   :export (pr prn prnn))
 (use (argyle base mac)
-     (argyle base ctrl))
+     (argyle base fn)
+     (argyle base ctrl)
+     (ice-9 pretty-print))
 
 (mac pr
   ((v1) #'(display v1))
@@ -13,3 +15,8 @@
 (mac prnn
   ((v1) #'(prn v1))
   ((v1 v2 ...) #'(do (prn v1) (prnn v2 ...))))
+
+(defp pprn pretty-print)
+
+(defp format (str . args)
+  (apply format str #t args))

argyle/base/type/lst.scm

@@ -1,8 +1,11 @@
 (ns (argyle base type lst))
-(use (argyle base fn))
+(use (argyle base fn)
+     (srfi srfi-1))
+(export filter reduce)
 
 (defp lst list)
 (defp lst? list?)
+(defp empty? null?)
 (defp lst-> list->array)
 (defp lst-> list->bitvector)
 (defp lst-> list->char-set)
@@ -17,4 +20,7 @@
 (defp lst! list-set!)
 (defp lst-hd list-head)
 (defp lst-tl list-tail)
+(defp unique delete-duplicates)
+(defp unique! delete-duplicates!)
 
+(defp range iota)

argyle/data/set.scm

@@ -0,0 +1,17 @@
+(ns (argyle data set))
+(use (argyle base)
+     (argyle data))
+
+(trans set (t)
+   :init (%mke-set t)
+   :app (fn (v) (hash-set! (set-t self) v v) self))
+
+(defp set args
+  (ret set (%mke-set (make-hash-table))
+    (for-each (\\ set _) args)))
+
+(defp has? (set v)
+  (hash-ref (set-t set) v))
+
+(defp elements (set)
+  (hash-map->list (fn (k v) v) (set-t set)))

argyle/data/tbl.scm

@@ -1,6 +1,7 @@
 (ns (argyle data tbl)
   :export (<tbl> tbl tbl? tbl-t tbl-t! tbl-fn tbl-fn!))
 (use (argyle base)
+     (argyle loop)
      ((argyle guile) :select (grp))
      (argyle data))
 
@@ -10,7 +11,9 @@
   :app (fns
         (() (tbl-t self))
         ((k) (hash-ref (tbl-t self) k))
-        ((k v) (hash-set! (tbl-t self) k v))))
+        ((k v)
+         (hash-set! (tbl-t self) k v)
+         self)))
 
 ;;; Consider using w/tbl as dflt ctor
 (defp mke-tbl (#:o (n 0))
@@ -33,6 +36,21 @@
 
 (defp tbl-cnt (pred t) (hash-count pred (t)))
 (defp tbl-clr! (t) (hash-clear! (t)))
-(defp tbl-fold (f init t) (hash-fold fun init (t)))
-(defp tbl-each (f t) (hash-for-each fun (t)))
+(defp tbl-fold (f init t) (hash-fold f init (t)))
+(defp tbl-each (f t) (hash-for-each f (t)))
 (defp tbl-map->lst (f t) (hash-map->list f (t)))
+
+(defp update (t k fn)
+  (t k (fn (t k))))
+
+(def ifcons (head tail)
+  (if tail (cons head tail)
+      (lst head)))
+
+(defp grp-by (pred seq)
+  (loop ((for elt (in-list seq))
+         (where t (tbl)
+                (update t (pred elt)
+                        (\\ ifcons elt _))))
+    => (tbl-map->lst (fn (k v) (lst k (reverse v)))
+                     t)))

argyle/data/vec.scm

@@ -23,7 +23,9 @@
 (defp lst->vec (lst) (%mke-vec (list->vector lst)))
 (defp vec-cpy (v) (%mke-vec (vector-copy (v))))
 (defp vec-fill! (v fill) (vector-fill! (v) fill))
-(defp vec<-! (v1 s1 e1 v2 s2) (vector-move-left! (v1) s1 e1 (v2) s2))
-(defp vec->! (v1 s1 e1 v2 s2) (vector-move-right! (v1) s1 e1 (v2) s2))
-(defp vec-map (fun v . vs) (apply vector-map fun (v) (map (fn (v) (v)) vs)))
+(defp vec-map (f v . vs)
+  (%mke-vec
+   (apply vector-map (fn (i e1 . es) (apply f e1 es))
+          (v)
+          (map (fn (v) (v)) vs))))
 ;;; Etc...

argyle/generic.scm

@@ -1,8 +1,9 @@
 (ns (argyle generic)
-  :replace (map)
   :export (gen <gen-fn> gen-fn? xtnd type
            len rev join cpy clr! kth))
 (use (argyle base)
+     ((argyle base type)
+      :select ((str . _str)))
      (argyle data)
      (argyle data tbl)
      (argyle data vec)
@@ -15,9 +16,8 @@
   ((name f) (id? #'name)
    #'(def name (%gen-fn 'name (tbl 'def f))))
   ((name) (id? #'name)
-   #'(def name (%gen-fn 'name (ret t (tbl)
-                                (when (defd? 'name)
-                                  (t 'def name)))))))
+   #'(def name (%gen-fn 'name (when (defd? 'name)
+                                (tbl 'def name))))))
 
 (trans gen-fn (name tbl)
   :init (%gen-fn name tbl)
@@ -29,7 +29,7 @@
 (def resolve-fn (tbl args)
   (loop lp ((for arg (in-list args))
             (where t tbl (and=> t (\\ _ (type arg)))))
-        => (cond ((and t (t 'fun)) (t 'fun))
+        => (cond ((and t (t 'fn)) (t 'fn))
                  ((and t (t 'rst)) (t 'rst))
                  ((tbl 'def) (tbl 'def))
                  (else (err "No generic fn for args1:" args)))
@@ -50,25 +50,26 @@
   ((name (arg1 ... . rest) body ...) (~(nil? #'rest))
    (let-syn (args types) (split #'(arg1 ...))
      #`(loop ((for type  (in-list 'types))
-              (where tbl (gen-fn-tbl name)
-                (if (tbl type) (tbl type)
-                     (tbl type (mke-tbl)))))
-        => (tbl 'rst (fn (#,@#'args . rest) body ...)))))
-  ((name (arg1 ...) body ...) (defd? (syn->dat #'name))
+              (where type-tree (gen-fn-tbl name)
+                (or (type-tree type)
+                    (do (type-tree type (mke-tbl))
+                        (type-tree type)))))
+        => (type-tree 'rst (fn (#,@#'args . rest) body ...)))))
+  ((fn-name (arg1 ...) body ...) (defd? (syn->dat #'fn-name))
    (let-syn (args types) (split #'(arg1 ...))
             ;; TODO: refactor
-     #`(loop ((for type  (in-list 'types))
-              (where tbl (gen-fn-tbl name)
-                (if (tbl type) (tbl type)
-                     (tbl type (mke-tbl)))))
-        => (tbl 'fun (fn args body ...))))))
+     #`(loop ((for type (in-list 'types))
+              (where type-tree (gen-fn-tbl fn-name)
+                     (or (type-tree type)
+                         (do (type-tree type (mke-tbl))
+                             (type-tree type)))))
+         => (type-tree 'fn (fn args body ...))))))
 
 (gen len length)
 (gen rev reverse)
 (gen join append)
 (gen cpy lst-cpy)
 (gen clr! (fn (lst) (set-cdr! lst '())))
-(gen map (@ (srfi srfi-1) map))
 
 (gen car)
 (gen cdr)
@@ -76,34 +77,24 @@
 (gen take)
 (gen drop)
 
-(xtnd len (s <str>) (str-len s))
-(xtnd len (n <int>) (len (str n)))
+(defp str args
+  (reduce-right str-join "" (map _str args)))
+
 (xtnd len (t <tbl>) (tbl-cnt (const #t) t))
 (xtnd len (v <vec>) (vec-len v))
 (xtnd len (q <q>) (q-len q))
 (xtnd len (stream <strm>) (strm-len stream))
 
-(xtnd rev (v <vec>)
-  (ret v* (mke-vec (vec-len v))
-    (vec<-! v 0 (vec-len v) v* 0)))
 (xtnd rev (s <str>) (string-reverse s))
 
 (xtnd join (s1 <str> . rest) (apply str-join s1 rest))
-(xtnd join (v1 <vec> v2 <vec>)
-  (w/ (l1 (vec-len v1) l2 (vec-len v2))
-      (ret v (mke-vec (+ l1 l2))
-        (vec->! v1 0 l1 v 0)
-        (vec->! v2 0 l2 v l1))))
+
 (xtnd join (strms <strm>) (strm-join strms))
 
 (xtnd cpy (v <vec>) (vec-cpy v))
 (xtnd cpy (q <q>) (%mke-q (q-len q) (q-hd q) (q-tl q)))
 (xtnd clr! (t <tbl>) (tbl-clr! t))
 (xtnd clr! (q <q>) (q-hd! q '()) (q-tl! q '()) (q-len! q 0))
-(xtnd map (f <fn> v <vec> . rst) (apply vec-map f v rst))
-(xtnd map (f <fn> s <str> . rst) (apply str-map f s rst))
-(xtnd map (f <fn> t <tbl>) (tbl-map->lst f t))
-(xtnd map (f <fn> s <strm> . rst) (apply strm-map f s rst))
 
 (xtnd car (seq <strm>) (scar seq))
 (xtnd car (seq <vec>) (seq 0))

argyle/generic/base.scm

@@ -0,0 +1,5 @@
+(ns (argyle generic base))
+(use (argyle base)
+     (argyle generic))
+
+(xtnd len (n <int>) (len (str n)))

argyle/generic/coll.scm

@@ -0,0 +1,19 @@
+(ns (argyle generic coll))
+
+(use (argyle base)
+     (argyle generic)
+     (argyle data tbl)
+     (argyle data vec)
+     (argyle data q)
+     (argyle data set))
+
+(gen map (@ (srfi srfi-1) map))
+(xtnd map (f <fn> v <vec>) (vec-map f v))
+(xtnd map (f <fn> s <str> . rst) (apply str-map f s rst))
+(xtnd map (f <fn> t <tbl>) (tbl-map->lst f t))
+
+(gen filter)
+
+(gen reduce)
+(gen cpy)
+