nydp 0.2.3 → 0.2.5

data/lib/lisp/core-045-dox-utils.nydp

@@ -4,7 +4,7 @@
   (inspect src))
 
 (def dox-show-info (name what texts args src)
-  ; show the given dox info
+  ; show the given info.src dox info
   ; 'info arg is a dox object from the dox system
   "~(if (eq? what 'mac) "Macro"
         (eq? what 'def) "Function"
@@ -58,7 +58,7 @@ Examples for ~name
          (if (no infos)
              (p "No documentation for" ',name)
              (each info infos
-                   (p (dox-show-info info.name info.what info.texts info.args))))
+                   (p (dox-show-info info.name info.what info.texts info.args info.src))))
          (let examples (dox-examples ',name)
            (if (no examples)
                (p "No examples for" ',name)

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

@@ -1,9 +1,88 @@
+(def bm-cond ()
+  (if (< 3 5) "less" "more"))
+
+(def bm-cond-lex (var)
+  (if var "present" "absent"))
+
+(def bm-cond-sym ()
+  (if bm-cond-sym-value "present" "absent"))
+
+(def bm-cond-3 ()
+  (bm-cond-lex 1)
+  (bm-cond-lex nil))
+
+(def bm-cond-4 ()
+  (assign bm-cond-sym-value 1)
+  (bm-cond-sym)
+  (assign bm-cond-sym-value nil)
+  (bm-cond-sym))
+
+(def bm-cond-LEX-LEX-LIT (a b)
+  (if a b nil))
+
+(def bm-cond-LEX-CND-LIT (a)
+  (if a (if (< a 3) "yes" "no") "other"))
+
+(def bm-cond-6 ()
+  (if (< 3 5) (+ 3 5) (- 3 5)))
+
+(def bm-cond-7 ()
+  (bm-cond-LEX-CND-LIT nil)
+  (bm-cond-LEX-CND-LIT 1)
+  (bm-cond-LEX-CND-LIT 5))
+
+(def bm-cond-5 ()
+  (bm-cond-LEX-LEX-LIT 1 2)
+  (bm-cond-LEX-LEX-LIT nil 3))
+
+(def bm-cond-OR (x)
+  (if x x "no"))
+
+(def bm-cond-OR2 (x y z)
+  (if x x (if y y z)))
+
+(def bm-cond-8 ()
+  (bm-cond-OR 1)
+  (bm-cond-OR nil))
+
+(def bm-cond-OR-LEX-LEX (x y)
+  (if x x y))
+
+(def bm-cond-9 ()
+  (bm-cond-OR-LEX-LEX 1)
+  (bm-cond-OR-LEX-LEX nil))
+
+(def bm-cond-10 ()
+  (bm-cond-OR2 1 2 3)
+  (bm-cond-OR2 nil 2 3)
+  (bm-cond-OR2 nil nil 3)
+  (bm-cond-OR2 nil nil nil))
+
+(def bm-cond-lex-lit-lit ()
+  (no nil)
+  (no 1))
+
+(def bm-faster-do ()
+  (each x '(0 1 2 3 4 5 6 7 8 9) ;; each uses 'do internally
+    x))
 
 (def bm-pythag ()
   (for i 1 50
     (for j 1 50
       (sqrt (+ (* i i) (* j j))))))
 
+(def bm-len-str ()
+  (len "abcd"))
+
+(def bm-len-pair ()
+  (len '(a b c d)))
+
+(def bm-len-hash ()
+  (len {a 1}))
+
+(def bm-len-fn ()
+  (len list))
+
 (def bm-repeat (f n)
   (for b 1 n (f)))
 
@@ -102,31 +181,17 @@
 
 (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 "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)
+    ;; (push (bm "cond with OR       "   bm-cond-9             10  40000) summary)
+    ;; (push (bm "cond with OR       "   bm-cond-9             10  100000) summary)
+    ;; (push (bm "cond with OR       "   bm-cond-lex-lit-lit             10  100000) summary)
+    ;; (push (bm "optimise DO forms "   bm-faster-do             10  10000) summary)
+    ;; (push (bm "length of string "   bm-len-str              10  40000) summary)
+    (push (bm "length of pair "     bm-len-pair             10  10000) summary)
+    ;; (push (bm "length of hash "     bm-len-hash             10  15000) summary)
+    ;; (push (bm "length of uncountable "     bm-len-fn        10  50000) summary)
+    ;; (push (bm "cond               "   bm-cond-3             10   50000) summary)
+    ;; (push (bm "cond               "   bm-cond-4             10   50000) summary)
+    ;; (push (bm "cond               "   bm-cond-5             10   50000) summary)
+    ;; (push (bm "cond               "   bm-cond-6             10   50000) summary)
+    ;; (push (bm "cond               "   bm-cond-7             10   50000) summary)
     (each s summary (p name " " s))))

data/lib/lisp/tests/all-examples.nydp

@@ -0,0 +1,20 @@
+(examples-for all?
+  ("true when all items are numeric"
+   (all? num? '(1 2 3 4))
+   t)
+
+  ("false when all items are not numeric"
+   (all? num? '(1 2 x 4))
+   nil)
+
+  ("true for an atom"
+   (and (all? string? "really, all") t)
+   t)
+
+  ("false for nil"
+   (all? x1 nil)
+   nil)
+
+  ("false when any item is nil"
+   (and (all? x1 '(1 2 nil 4)) t)
+   nil))

data/lib/lisp/tests/any-examples.nydp

@@ -0,0 +1,28 @@
+(examples-for any?
+  ("true when any item is non-nil"
+   (and (any? num? '(1 nil nil 4)) t)
+   t)
+
+  ("true for an atom"
+   (and (any? string? "really, all") t)
+   t)
+
+  ("false for an atom"
+   (any? num? "really, all")
+   nil)
+
+  ("false for nil"
+   (any? x1 nil)
+   nil)
+
+  ("false when all items are nil"
+   (any? sym? '(nil nil nil nil))
+   nil)
+
+  ("true when at least one item is nil when looking for nil"
+   (any? no '(1 2 nil 4))
+   t)
+
+  ("false when no item is nil when looking for nil"
+   (any? no '(1 2 3 4))
+   nil))

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

@@ -78,7 +78,9 @@
   ("multiplies 1 float"   (* 4.2)          4.2)
   ("multiplies 2 floats"  (* 4.2 0.5)      2.1)
   ("multiplies 3 floats"  (* 4.2 -2.5)   -10.5)
-  ("multiplies 4 floats"  (* 6.6 1.1 3.3) 23.958))
+  ("multiplies 4 floats"  (* 6.6 1.1 3.3) 23.958)
+
+  ("multiplies a string"  (* "foo" 3)     "foofoofoo"))
 
 (examples-for mod
   ("modulus for two ints" (mod 64 6) 4))

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

@@ -27,6 +27,16 @@
             "zz")
    nil))
 
+(examples-for compact
+  ("removes all nil items in list"
+   (compact (list 'a 'b nil 'c nil 'd nil nil))
+   (a b c d)))
+
+(examples-for +0
+  ("only adds non-nil items"
+   (+nz 1 2 nil 3 nil 4 nil nil)
+   10))
+
 (examples-for reject
   ("returns all non-matching items in a list"
    (reject (fn (x) (eq? (len x) 2))

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

@@ -2,7 +2,7 @@
   (list a b c d e))
 
 (examples-for curry
-  ("zero-params"
+  ("zero-params assumes nil initial parameter"
    (let ck0 (curry chicken-korma)
      (ck0 1 2 3 4 5))
    (1 2 3 4 5))
@@ -12,12 +12,17 @@
      (ck0 1 2 3 4))
    (x 1 2 3 4))
 
+  ("nestable"
+   (let ck0 (curry chicken-korma 'x)
+     ((curry ck0 'y) 1 2 3))
+   (x y 1 2 3))
+
   ("two params"
    (let ck0 (curry chicken-korma 'x 'y)
      (ck0 1 2 3))
    (x y 1 2 3))
 
-  ("three params"
+  ("three params ignores second and third params"
    (let ck0 (curry chicken-korma 'x 'y 'z)
      (ck0 1 2))
    (x y z 1 2)))

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

@@ -14,6 +14,17 @@
      x)
    "impossible")
 
+  ("handles nested errors"
+    (on-err (joinstr "\n" errors)
+            (on-err (error "foo")
+                    (on-err (error "bar")
+                            (on-err (error "toto")
+                                    (error "primum errorum")))))
+    "\"foo\"
+\"bar\"
+\"toto\"
+\"primum errorum\"")
+
   ("handles errors but any ensuring clause gets called first"
    (with (x nil y nil)
          (on-err (= x 'impossible)

data/lib/lisp/tests/foundation-test.nydp

@@ -90,6 +90,72 @@
    (if t "hello" "goodbye")
    "hello")
 
+  ("function condition"
+   (if (> 5 3) "hello" "goodbye")
+   "hello")
+
+  ("function condition and outcome"
+   (if (> 5 3) (+ 5 3) (- 5 3))
+   8)
+
+  ("global symbol : true"
+   (do (assign global-symbol-if-test 1)
+       (if global-symbol-if-test "yes" "no"))
+   "yes")
+
+  ("global symbol : false"
+   (do (assign global-symbol-if-test nil)
+       (if global-symbol-if-test "yes" "no"))
+   "no")
+
+  ("condition and when-true are the same ; literal when-false (true)"
+   (let x 1 (if x x "no"))
+   1)
+
+  ("condition and when-true are the same ; literal when-false (false)"
+   (let x nil (if x x "no"))
+   "no")
+
+  ("condition and when-true are the same ; cond when-false (true)"
+   (with (x 1 y 2) (if x x (if y y "else")))
+   1)
+
+  ("condition and when-true are the same ; cond when-false (false/true)"
+   (with (x nil y 2) (if x x (if y y "else")))
+   2)
+
+  ("condition and when-true are the same ; cond when-false (false/false)"
+   (with (x nil y nil) (if x x (if y y "else")))
+   "else")
+
+  ("locally-bound condition: true"
+   (let x 1 (if x "yes" "no"))
+   "yes")
+
+  ("locally-bound condition: false"
+   (let x nil (if x "yes" "no"))
+   "no")
+
+  ("locally-bound cond and truth : true"
+   (with (x 1 y "yes") (if x y "no"))
+   "yes")
+
+  ("locally-bound cond and truth : false"
+   (with (x nil y "yes") (if x y "no"))
+   "no")
+
+  ("cond with locally-bound condition, conditional if true, literal when false : true/false"
+   (let x 1 (if x (if (> x 5) "wrong" "right") "otherwise"))
+   "right")
+
+  ("cond with locally-bound condition, conditional if true, literal when false : true/true"
+   (let x 22 (if x (if (> x 5) "wrong" "right") "otherwise"))
+   "wrong")
+
+  ("cond with locally-bound condition, conditional if true, literal when false : false"
+   (let x nil (if x (if (> x 5) "wrong" "right") "otherwise"))
+   "otherwise")
+
   ("nil is boolean false"
    (if nil "hello" "goodbye")
    "goodbye"))

data/lib/lisp/tests/len-examples.nydp

@@ -3,6 +3,7 @@
   ("zero"          (len "")         0)
   ("nil is zero"   (len nil)        0)
   ("sym is nil"    (len 'abc)       nil)
+  ("fn is nil"     (len len)        nil)
   ("number is nil" (len 234)        nil)
 
   ("ignores backslash-escaped interpolation symbol"  (len "hello \~world")  12)

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

@@ -0,0 +1,25 @@
+(examples-for list-gsub
+  ("it replaces a number in a nested list"
+   (list-gsub '(foo (1 2 3 42)
+                    (bar (40 41 42 (nested 43 42 41))))
+              42
+              99)
+   (foo (1 2 3 99)
+        (bar (40 41 99 (nested 43 99 41)))))
+
+  ("it replaces a sym in a nested list"
+   (list-gsub '(foo (1 2 3 42)
+                    (foo (40 41 42 (foo 43 42 foo))))
+              'foo
+              'zzz)
+   (zzz (1 2 3 42)
+        (zzz (40 41 42 (zzz 43 42 zzz)))))
+
+
+  ("it replaces a list in a nested list"
+   (list-gsub '(foo (1 (a b c) 3 42)
+                    (foo (40 (a b c) 42 ((a b c) 43 42 foo))))
+              '(a b c)
+              'zzz)
+   (foo (1 zzz 3 42)
+        (foo (40 zzz 42 (zzz 43 42 foo))))))

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

@@ -0,0 +1,40 @@
+(examples-for list-match?
+  ("match the first element of a list"
+   (list-match? (list (curry eq? 'foo))
+                '(foo bar zorro))
+   t)
+
+  ("the first element is a sym and the second element is a number: true"
+   (list-match? (list sym? num?)
+                '(foo 1 blah blah matches))
+   t)
+
+  ("the first element is a sym and the second element is a number: wrong first element"
+   (list-match? (list sym? num?)
+                '("doesn't" 1 match at all))
+   nil)
+
+  ("the first element is a sym and the second element is a number: wrong second element"
+   (list-match? (list sym? num?)
+                '(does not match at all))
+   nil)
+
+  ("list has 3 elements: true"
+   (list-match? λx(eq? (len x) 3)
+                '(this does match))
+   t)
+
+  ("list has 3 elements: false"
+   (list-match? λx(eq? (len x) 3)
+                '(this does not match))
+   nil)
+
+  ("match improper list: true"
+   (list-match? (cons num? (cons sym? sym?))
+                '(10 green . bottles))
+   t)
+
+  ("match improper list: false"
+   (list-match? (cons sym? (cons num? sym?))
+                '(this doesnt match))
+   nil))

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

@@ -1,3 +1,8 @@
+(examples-for iso
+  ("(nil) is not the same as nil"
+   (iso '(nil) nil)
+   nil))
+
 (examples-for pair?
   ("  t for a cons"    (pair? '(1 a 2 b 3 c))  t)
   ("nil for a number"  (pair? 1)               nil)
@@ -67,6 +72,10 @@
    (nthcdr 3 '(a b c d e))
    (d e))
 
+  ("returns nothing for n = size of list"
+   (nthcdr 5 '(a b c d e))
+   nil)
+
   ("returns nothing for n > size of list"
    (nthcdr 33 '(a b c d e))
    nil))
@@ -129,6 +138,10 @@
    (list-slices '(a b c d e) 12)
    ((a b c d e)))
 
+  ("nothing but the list if the list is exactly the length of the page"
+   (list-slices '(a b c) 3)
+   ((a b c)))
+
   ("exactly three lists"
    (list-slices '(a b c d e f g h i) 3)
    ((a b c) (d e f) (g h i)))