3 Commits 5ea07178d6 ... 1ff6e1e041

Author SHA1 Message Date
  Dylan Jeffers 1ff6e1e041 Fix rst arg error 7 years ago
  Dylan Jeffers 9ba768b7f8 Update gen-fn xtnd: dont check for defined var 7 years ago
  Dylan Jeffers 9112c918e0 Fix ->> 7 years ago
4 changed files with 16 additions and 12 deletions
  1. 1 1
      argyle/base/fn.scm
  2. 0 1
      argyle/base/type/lst.scm
  3. 13 8
      argyle/generic.scm
  4. 2 2
      argyle/match.scm

+ 1 - 1
argyle/base/fn.scm

@@ -51,7 +51,7 @@
 
 ;;; Replace w/ => when loop export is handled
 (mac ->>
-  ((exp fn ...) #'((compose fn ...) exp)))
+  ((exp f ...) #`((compose #,@(reverse #'(f ...))) exp)))
 
 (mac inline
   ((name (arg ...) body ...)

+ 0 - 1
argyle/base/type/lst.scm

@@ -22,5 +22,4 @@
 (defp lst-tl list-tail)
 (defp unique delete-duplicates)
 (defp unique! delete-duplicates!)
-
 (defp range iota)

+ 13 - 8
argyle/generic.scm

@@ -1,6 +1,7 @@
 (ns (argyle generic)
   :export (gen <gen-fn> gen-fn? xtnd type
-           len rev join cpy clr! kth))
+           str len rev join cpy clr!
+           map))
 (use (argyle base)
      ((argyle base type)
       :select ((str . _str)))
@@ -47,15 +48,15 @@
 (mac xtnd x
   (def split (lst)
     (c/vals (fn () (unzip2 (grp lst 2))) list))
-  ((name (arg1 ... . rest) body ...) (~(nil? #'rest))
+  ((fn-name (arg1 ... . rest) body ...) (~(nil? #'rest))
    (let-syn (args types) (split #'(arg1 ...))
      #`(loop ((for type  (in-list 'types))
-              (where type-tree (gen-fn-tbl name)
+              (where type-tree (gen-fn-tbl fn-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))
+  ((fn-name (arg1 ...) body ...)
    (let-syn (args types) (split #'(arg1 ...))
             ;; TODO: refactor
      #`(loop ((for type (in-list 'types))
@@ -80,10 +81,7 @@
 (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 len (n <int>) (length (str n)))
 
 (xtnd rev (s <str>) (string-reverse s))
 
@@ -103,3 +101,10 @@
 (xtnd take (seq <strm> k <int>) (strm-take k seq))
 (xtnd drop (seq <strm> k <int>) (strm-drop k seq))
 (xtnd kth (seq <vec> k <int>) (seq k))
+
+;;; Collections
+
+(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))

+ 2 - 2
argyle/match.scm

@@ -91,8 +91,8 @@
   (_def fn-match (exp)
     (syn-case exp ()
       (((pat ... . rst) b1 b2 ...)
-       (let-syn pat:exps #`(#,@(parse-params #'(pat ...)) . rst)
-         #`(#,(map cadr #'pat:exps)
+       (let-syn pat:exps (parse-params #'(pat ...))
+         #`((#,@(map cadr #'pat:exps) . rst)
             (match-xpnd #,(splice #'pat:exps) b1 b2 ...))))))
   
   ;; TODO: mac instead?