nydp 0.2.2 → 0.2.3

data/lib/lisp/core-041-string-utils.nydp

@@ -0,0 +1,28 @@
+(chapter-start 'string-manipulation "utilities for manipulating strings")
+
+(def string-strip (txt)
+  (string-replace "(^\\s+|\\s+$)" "" txt))
+
+(def joinstr (txt . things)
+  ; flatten 'things into a single list (ie unnest lists)
+  ; convert each item to a string
+  ; return a single string which is the concatenation of each
+  ; stringified item, with given 'txt inserted in between
+  ; each item
+  (let joinables (flatten things)
+    (apply +
+           (to-string (car joinables))
+           (flatten (zip (map (fn (_) txt) (cdr joinables))
+                         (map to-string (cdr joinables)))))))
+
+(def j items
+  ; delegate to 'joinstr with an empty join string
+  ; shortcut for (joinstr ""  items)
+  (joinstr "" items))
+
+(def string-pieces pieces
+  ; string-interpolation syntax emits this form. Default implementation
+  ; is to delegate to 'j , but containing forms may use macros that
+  ; override this in order to provide specific interpolation behaviour
+  ; (for example, formatting numbers or stripping HTML tags)
+  (j pieces))

data/lib/lisp/core-042-date-utils.nydp

@@ -0,0 +1,5 @@
+(chapter-start 'date-time "utilities for retrieving and manipulating dates and times")
+
+(def today ()
+  ; return a date for the current day
+  (date))

data/lib/lisp/core-043-list-utils.nydp

@@ -0,0 +1,157 @@
+(chapter-start 'list-manipulation)
+
+(def list-length (things)
+  (if (no things)    0
+      (atom? things) 1
+      (+ 1 (list-length:cdr things))))
+
+(def list-slices (things slice-size)
+     ; slice 'things into a list of lists each with maximum 'slice-size items
+     (chapter pagination)
+     (if (< (len things) slice-size)
+         (cons things nil)
+         (cons (firstn slice-size things)
+               (list-slices (nthcdr slice-size things)
+                            slice-size))))
+
+(def intersperse (inbetween things)
+  ; return a new list with 'inbetween in between every element of 'things
+  (if (and (pair? things) (cdr things))
+      (apply list (car things) inbetween
+             (intersperse inbetween (cdr things)))
+      things))
+
+(def intersperse-splicing (inbetween things)
+  ; expects 'things a list of lists, joins the lists
+  ; placing 'inbetween in between each list.
+  ; For example (intersperse-splicing 'X '((a b) (c d) (e f)))
+  ; returns (a b X c d X e f)
+  (apply joinlists (intersperse (list inbetween) things)))
+
+(def collect (f things)
+  ; if 'things is a list, return all the items in the list for which 'f returns non-nil
+  ; otherwise, return 'things if (f things) is non-nil
+  ; otherwise, nil
+  (rfnwith collector (items things)
+           (if (no items)
+               nil
+               (pair? items)
+               (if (f (car items))
+                   (cons (car items)
+                         (collector (cdr items)))
+                   (collector (cdr items)))
+               (f items)
+               items)))
+
+(def reject (f things)
+  ; return all the items in 'things for which 'f returns nil
+  (collect !f things))
+
+(def nth (n things)
+  ; returns the n-th item in the list 'things
+  (if (eq? n 0)
+      (car things)
+      (nth (- n 1) (cdr things))))
+
+(mac each (var things code)
+  ; repeatedly assigns an element of 'things to 'var,
+  ; and executes 'code each time
+  (w/uniq (xs c)
+          `((rfn ,c (,xs)
+                (if (pair? ,xs)
+                    (do
+                        (let ,var (car ,xs) ,code)
+                        (,c (cdr ,xs)))))
+           ,things)))
+
+(def reduce (f things)
+  ((rfn rd (acc list)
+        (if (pair? list)
+            (rd (f acc (car list))
+                (cdr list))
+            acc))
+   (car things) (cdr things)))
+
+(def proper? (list)
+  ; t if this is a proper list (last cdr is nil)
+  ; nil otherwise (last cdr is neither cons nor nil)
+  (or (no list)
+      (and (pair? list)
+           (proper? (cdr list)))))
+
+(def firstn (n things)
+  ; returns the first 'n items in the list 'things
+  (if (eq? n 0) nil
+      (cons (car things)
+            (firstn (- n 1)
+                    (cdr things)))))
+
+(def nthcdr (n things)
+  ; returns the nth cdr of the list 'things
+  (if (> n 0)
+      (nthcdr (- n 1) (cdr things))
+      things))
+
+(def joinlists (things . more-thingses)
+  ; return a new list which is the concatenation of all the given lists
+  ; 'things is a list
+  ; 'more-thingses is a list of lists
+  ; call like this: (joinlists '(a b c) '(x y z) '(1 2 3))
+  (if things
+      (cons (car things)
+            (apply joinlists
+                   (cdr things)
+                   more-thingses))
+      more-thingses
+      (apply joinlists more-thingses)))
+
+(def detect (f things)
+  ; if 'f is a function,
+  ;   if 'things is a list, return the first item in the list for which 'f returns non-nil
+  ;   otherwise, return 'things if (f things) is non-nil
+  ;   otherwise, nil
+  ; if 'f is not a function, self-invoke with a function checking for equality with f
+  ;
+  ; WARNING: if the detected thing is nil, returns t instead. A return value of nil
+  ; means the thing was not found ; non-nil means the thing was found, including when
+  ; the found thing is itself nil.
+  (if (isa 'fn f)
+      (rfnwith d (items things)
+                 (if (pair? items)
+                     (let it (car items)
+                       (or
+                        (and (f it)
+                             (or it t))
+                        (d:cdr items)))
+                     (f items)
+                     items))
+      (detect (curry eq? f)
+              things)))
+
+(def tuples (n things)
+  ;; split things into a list of lists each n long
+  (rfnwith _ (list things)
+           (if (no list)
+               nil
+               (cons (firstn n list) (_ (nthcdr n list))))))
+
+(def range (start stop)
+  ; return a list containing the range
+  ; of elements starting with 'start, up
+  ; to but not including 'stop
+  (if (< start stop)
+      (cons start
+            (range (+ start 1)
+                   stop))))
+
+(def best (f things)
+  (if (no things)
+      nil
+      (let winner (car things)
+        (each thing (cdr things)
+              (if (f thing winner)
+                  (= winner thing)))
+        winner)))
+
+(def min things (best < things))
+(def max things (best > things))

data/lib/lisp/core-060-benchmarking.nydp

@@ -21,103 +21,112 @@
           (p "================================================\n")
           "~desc : total ~(just times), average ~(/ times repeats) per run"))
 
-(assign a 1)
-(assign b 1)
-
-(def bm-add-globals () (+ a b))
-
-(def bm-lc-0 () 0)
-(def bm-lc-1 (a) a)
-(def bm-lc-2 (a b) (a b))
-(def bm-lc-3 (a b c) (a b c))
-(def bm-lc-4 (a b c d) (a b c d))
-
-(def bm-lc-0R a a)
-(def bm-lc-1R (a . b) (apply a b))
-(def bm-lc-2R (a b . c) (apply a b c))
-(def bm-lc-3R (a b c . d) (apply a b c d))
-(def bm-lc-4R (a b c d . e) (apply a b c d e))
-
-(def bm-plus-0 () (+))
-(def bm-plus-1 (a) (+ a))
-(def bm-plus-2 (a b) (+ a b))
-(def bm-plus-3 (a b c) (+ a b c))
-
-(def bm-0-arg-times-call () (*))
-(def bm-1-arg-times-call () (* 23))
-(def bm-2-arg-times-call () (* 23 24))
-(def bm-3-arg-times-call () (* 23 24 25))
-(def bm-4-arg-times-call () (* 23 24 25 26))
-
-(def bm-plus-0-call () (bm-plus-0))
-(def bm-plus-1-call () (bm-plus-1 1))
-(def bm-plus-2-call () (bm-plus-2 1 2))
-(def bm-plus-3-call () (bm-plus-3 1 2 3))
-
-(def bm-0-lc-call () (bm-lc-0))
-(def bm-1-lc-call () (bm-lc-1 +))
-(def bm-2-lc-call () (bm-lc-2 + 1))
-(def bm-3-lc-call () (bm-lc-3 + 1 2))
-(def bm-4-lc-call () (bm-lc-4 + 1 2 3))
-
-(def bm-0R-lc-call () (bm-lc-0R +))
-(def bm-1R-lc-call () (bm-lc-1R + 1))
-(def bm-2R-lc-call () (bm-lc-2R + 1 2))
-(def bm-3R-lc-call () (bm-lc-3R + 1 2 3))
-(def bm-4R-lc-call () (bm-lc-4R + 1 2 3 4))
-
-(def bm-complicated-0 (a b c) (a (+ 1 b) (+ 1 c)))
-
-(def bm-complicated ()
-  (bm-complicated-0 +
-                    (bm-complicated-0 * 3 (bm-complicated-0 + 3 6))
-                    (bm-complicated-0 - 10 (bm-complicated-0 - 13 8))))
-
-(def bm-pre-compile-test ()
-  (for i 1 10
-       (pre-compile (dox-src rbs))))
-
-(def bm-hash-fill
-  (let h {}
-    (=h.aa 1) (=h.ab 2) (=h.ac 3) (=h.ba 4) (=h.bb 5) (=h.bc 6)
-    (=h.ca 1) (=h.cb 2) (=h.cc 3) (=h.ca 4) (=h.cb 5) (=h.cc 6)
-    (=h.da 1) (=h.db 2) (=h.dc 3) (=h.da 4) (=h.db 5) (=h.dc 6)
-    (=h.aa 1) (=h.ab 2) (=h.ac 3) (=h.ba 4) (=h.bb 5) (=h.bc 6)
-    (=h.ca 1) (=h.cb 2) (=h.cc 3) (=h.ca 4) (=h.cb 5) (=h.cc 6)
-    (=h.da 1) (=h.db 2) (=h.dc 3) (=h.da 4) (=h.db 5) (=h.dc 6)
-    (list (list h.aa h.ab h.ac h.ba h.bb h.bc)
-          (list h.aa h.ab h.ac h.ba h.bb h.bc)
-          (list h.ca h.cb h.cc h.ca h.cb h.cc)
-          (list h.da h.db h.dc h.da h.db h.dc)
-          (list h.aa h.ab h.ac h.ba h.bb h.bc)
-          (list h.ca h.cb h.cc h.ca h.cb h.cc)
-          (list h.da h.db h.dc h.da h.db h.dc)
-          (list h.da h.ab h.ac h.ba h.bb h.bc))))
+;; (assign a 1)
+;; (assign b 1)
+
+;; (def bm-add-globals () (+ a b))
+
+;; (def bm-lc-0 () 0)
+;; (def bm-lc-1 (a) a)
+;; (def bm-lc-2 (a b) (a b))
+;; (def bm-lc-3 (a b c) (a b c))
+;; (def bm-lc-4 (a b c d) (a b c d))
+
+;; (def bm-lc-0R a a)
+;; (def bm-lc-1R (a . b) (apply a b))
+;; (def bm-lc-2R (a b . c) (apply a b c))
+;; (def bm-lc-3R (a b c . d) (apply a b c d))
+;; (def bm-lc-4R (a b c d . e) (apply a b c d e))
+
+;; (def bm-plus-0 () (+))
+;; (def bm-plus-1 (a) (+ a))
+;; (def bm-plus-2 (a b) (+ a b))
+;; (def bm-plus-3 (a b c) (+ a b c))
+;; (def bm-f-1 (a) (a))
+;; (def bm-f-2 (a b) (a b))
+;; (def bm-f-3 (a b c) (a b c))
+
+;; (def bm-0-arg-times-call () (*))
+;; (def bm-1-arg-times-call () (* 23))
+;; (def bm-2-arg-times-call () (* 23 24))
+;; (def bm-3-arg-times-call () (* 23 24 25))
+;; (def bm-4-arg-times-call () (* 23 24 25 26))
+
+;; (def bm-plus-0-call () (bm-plus-0))
+;; (def bm-plus-1-call () (bm-plus-1 1))
+;; (def bm-plus-2-call () (bm-plus-2 1 2))
+;; (def bm-plus-3-call () (bm-plus-3 1 2 3))
+;; (def bm-f-1-call () (for i 0 10 (bm-f-1 +)))
+;; (def bm-f-2-call () (for i 0 10 (bm-f-2 + 2)))
+;; (def bm-f-3-call () (for i 0 10 (bm-f-3 + 2 3)))
+
+;; (def bm-0-lc-call () (bm-lc-0))
+;; (def bm-1-lc-call () (bm-lc-1 +))
+;; (def bm-2-lc-call () (bm-lc-2 + 1))
+;; (def bm-3-lc-call () (bm-lc-3 + 1 2))
+;; (def bm-4-lc-call () (bm-lc-4 + 1 2 3))
+
+;; (def bm-0R-lc-call () (bm-lc-0R +))
+;; (def bm-1R-lc-call () (bm-lc-1R + 1))
+;; (def bm-2R-lc-call () (bm-lc-2R + 1 2))
+;; (def bm-3R-lc-call () (bm-lc-3R + 1 2 3))
+;; (def bm-4R-lc-call () (bm-lc-4R + 1 2 3 4))
+
+;; (def bm-complicated-0 (a b c) (a (+ 1 b) (+ 1 c)))
+
+;; (def bm-complicated ()
+;;   (bm-complicated-0 +
+;;                     (bm-complicated-0 * 3 (bm-complicated-0 + 3 6))
+;;                     (bm-complicated-0 - 10 (bm-complicated-0 - 13 8))))
+
+;; (def bm-pre-compile-test ()
+;;   (for i 1 10
+;;        (pre-compile (dox-src rbs))))
+
+;; (def bm-hash-fill
+;;   (let h {}
+;;     (=h.aa 1) (=h.ab 2) (=h.ac 3) (=h.ba 4) (=h.bb 5) (=h.bc 6)
+;;     (=h.ca 1) (=h.cb 2) (=h.cc 3) (=h.ca 4) (=h.cb 5) (=h.cc 6)
+;;     (=h.da 1) (=h.db 2) (=h.dc 3) (=h.da 4) (=h.db 5) (=h.dc 6)
+;;     (=h.aa 1) (=h.ab 2) (=h.ac 3) (=h.ba 4) (=h.bb 5) (=h.bc 6)
+;;     (=h.ca 1) (=h.cb 2) (=h.cc 3) (=h.ca 4) (=h.cb 5) (=h.cc 6)
+;;     (=h.da 1) (=h.db 2) (=h.dc 3) (=h.da 4) (=h.db 5) (=h.dc 6)
+;;     (list (list h.aa h.ab h.ac h.ba h.bb h.bc)
+;;           (list h.aa h.ab h.ac h.ba h.bb h.bc)
+;;           (list h.ca h.cb h.cc h.ca h.cb h.cc)
+;;           (list h.da h.db h.dc h.da h.db h.dc)
+;;           (list h.aa h.ab h.ac h.ba h.bb h.bc)
+;;           (list h.ca h.cb h.cc h.ca h.cb h.cc)
+;;           (list h.da h.db h.dc h.da h.db h.dc)
+;;           (list h.da h.ab h.ac h.ba h.bb h.bc))))
 
 (def rbs (name)
   (let summary nil
-    ;; (push (bm "pythag     "   bm-pythag            5      10) summary)
-    ;; (push (bm "recursive  "   bm-complicated       5    1000) summary)
-    (push (bm "global vars        "   bm-add-globals      10   50000) summary)
-    (push (bm "0 arg times        "   bm-0-arg-times-call 10   50000) summary)
-    (push (bm "1 arg times        "   bm-1-arg-times-call 10   50000) summary)
-    (push (bm "2 arg times        "   bm-2-arg-times-call 10   50000) summary)
-    (push (bm "SYM                "   bm-plus-0-call      10   50000) summary)
-    (push (bm "SYM LEX            "   bm-plus-1-call      10   50000) summary)
-    (push (bm "SYM LEX LEX        "   bm-plus-2-call      10   50000) summary)
-    (push (bm "SYM LEX LEX LEX    "   bm-plus-3-call      10   50000) summary)
-    ;; (push (bm "3 arg times"   bm-3-arg-times-call 10   100000) summary)
-    ;; (push (bm "4 arg times"   bm-4-arg-times-call 10   100000) summary)
-    ;; (push (bm "0R arg lexical-vars"   bm-0R-lc-call  10   50000) summary)
-    ;; (push (bm "1R arg lexical-vars"   bm-1R-lc-call  10   50000) summary)
-    ;; (push (bm "2R arg lexical-vars"   bm-2R-lc-call  10   50000) summary)
-    ;; (push (bm "3R arg lexical-vars"   bm-3R-lc-call  10   50000) summary)
-    ;; (push (bm "4R arg lexical-vars"   bm-4R-lc-call  10   50000) summary)
-    ;; (push (bm "0 arg lexical-vars "   bm-0-lc-call   10   50000) summary)
-    ;; (push (bm "1 arg lexical-vars "   bm-1-lc-call   10   50000) summary)
-    ;; (push (bm "2 arg lexical-vars "   bm-2-lc-call   10   50000) summary)
-    ;; (push (bm "3 arg lexical-vars "   bm-3-lc-call   10   50000) summary)
-    ;; (push (bm "4 arg lexical-vars "   bm-4-lc-call   10   50000) summary)
-    ;; (push (bm "hashing"       bm-hash-fill        10 200000) summary)
-    ;; (push (bm "pre-compile"   bm-pre-compile-test 10  10000) summary)
+    ;; (push (bm "pythag              "   bm-pythag            5       10) summary)
+    ;; (push (bm "recursive           "   bm-complicated       5     1000) summary)
+    ;; (push (bm "global vars         "   bm-add-globals      10    50000) summary)
+    ;; (push (bm "0 arg times         "   bm-0-arg-times-call 10    50000) summary)
+    ;; (push (bm "1 arg times         "   bm-1-arg-times-call 10    50000) summary)
+    ;; (push (bm "2 arg times         "   bm-2-arg-times-call 10    50000) summary)
+    ;; (push (bm "SYM                 "   bm-plus-0-call      10    50000) summary)
+    ;; (push (bm "SYM LEX             "   bm-plus-1-call      10    50000) summary)
+    ;; (push (bm "SYM LEX LEX         "   bm-plus-2-call      10    50000) summary)
+    ;; (push (bm "SYM LEX LEX LEX     "   bm-plus-3-call      10    50000) summary)
+    ;; (push (bm "3 arg times         "   bm-3-arg-times-call 10   100000) summary)
+    ;; (push (bm "4 arg times         "   bm-4-arg-times-call 10   100000) summary)
+    ;; (push (bm "0R arg lexical-vars "   bm-0R-lc-call       10    50000) summary)
+    ;; (push (bm "1R arg lexical-vars "   bm-1R-lc-call       10    50000) summary)
+    ;; (push (bm "2R arg lexical-vars "   bm-2R-lc-call       10    50000) summary)
+    ;; (push (bm "3R arg lexical-vars "   bm-3R-lc-call       10    50000) summary)
+    ;; (push (bm "4R arg lexical-vars "   bm-4R-lc-call       10    50000) summary)
+    ;; (push (bm "0 arg lexical-vars  "   bm-0-lc-call        10    50000) summary)
+    ;; (push (bm "1 arg lexical-vars  "   bm-1-lc-call        10    50000) summary)
+    ;; (push (bm "2 arg lexical-vars  "   bm-2-lc-call        10    50000) summary)
+    ;; (push (bm "3 arg lexical-vars  "   bm-3-lc-call        10    50000) summary)
+    ;; (push (bm "4 arg lexical-vars  "   bm-4-lc-call        10    50000) summary)
+    ;; (push (bm "hashing             "   bm-hash-fill        10   200000) summary)
+    ;; (push (bm "pre-compile         "   bm-pre-compile-test 10    10000) summary)
+    ;; (push (bm "LEX         "   bm-f-1-call 10    10000) summary)
+    ;; (push (bm "LEX LEX     "   bm-f-2-call 10    10000) summary)
+    ;; (push (bm "LEX LEX LEX "   bm-f-3-call 10    10000) summary)
     (each s summary (p name " " s))))

data/lib/lisp/core-090-hook.nydp

@@ -8,9 +8,12 @@
   (def add-hook (hook-name f)
     (hash-cons hooks hook-name f))
 
+  (def clear-hooks (hook-name)
+    (= hooks.,hook-name nil))
+
   (def remove-hook (hook-name f)
     (= hooks.,hook-name
-       (select (curry !eq? f)
+       (collect (curry !eq? f)
                hooks.,hook-name)))
 
   (def run-hooks (hook-name . args)

data/lib/lisp/tests/list-tests.nydp

@@ -37,6 +37,10 @@
    (joinlists '(a b c) '(x y z) '(1 2 3))
    (a b c x y z 1 2 3))
 
+  ("nil disappears"
+   (apply joinlists '( (a b c) (d e f) nil (j k l) ) )
+   (a b c d e f j k l))
+
   ("joins three lists without recursing"
    (joinlists '(a b c) '(x (y1 y2 y3) z) '(1 2 (3 3 3)))
    (a b c x (y1 y2 y3) z 1 2 (3 3 3))))
@@ -132,3 +136,33 @@
   ("three lists and an extra big"
    (list-slices '(a b c d e f g h i j k) 3)
    ((a b c) (d e f) (g h i) (j k))))
+
+(examples-for assoc
+  ("finds nothing in an empty list"
+   (assoc 'foo nil)
+   nil)
+
+  ("finds nothing in a non-list"
+   (assoc 'foo 'bar)
+   nil)
+
+  ("finds nothing for nonexistent key"
+   (assoc 'z '((a b) (c d)))
+   nil)
+
+  ("finds value corresponding to given key"
+   (assoc 'c '((a b) (c d)))
+   (c d)))
+
+(examples-for alref
+  ("finds nothing in an empty list"
+   (alref 'foo nil)
+   nil)
+
+  ("finds nothing for nonexistent key"
+   (alref 'z '((a b) (c d)))
+   nil)
+
+  ("finds value corresponding to given key"
+   (alref 'c '((a b) (c d)))
+   d))