nydp 0.1.2 → 0.1.3

data/lib/lisp/core-050-test-runner.nydp

@@ -30,11 +30,29 @@
         (if (iso result expected)
             (passf)
             (do (p desc " - " (car test) " - FAILED:
+   running  " (pp (nth 1 test)) ",
    expected " (inspect expected) ",
    got      " (inspect result) "
 ")
                 (failf)))))
 
 (def execute-tests (desc tests passf failf verbose)
-  (execute-test desc (car tests) passf failf verbose)
-  (if (cdr tests) (execute-tests desc (cdr tests) passf failf verbose)))
+  (execute-test desc
+                (car tests)
+                passf
+                failf
+                verbose)
+  (if (cdr tests)
+      (execute-tests desc
+                     (cdr tests)
+                     passf
+                     failf
+                     verbose)))
+
+(mac examples-for (name . examples)
+  (let suite-name "examples for ~(pp name)"
+    `(do
+         (register-test '(suite ,suite-name ,@examples))
+         (dox-add-examples ',name
+                           ',(collect (curry !caris 'comment)
+                                      examples)))))

data/lib/lisp/core-080-pretty-print.nydp

@@ -25,12 +25,16 @@
       (inspect thing)))
 
 (mac pp/def (name args . body)
+  ; define a pretty-printer function for forms beginning with the
+  ; given name. 'args are usually (form indent), form being the
+  ; complete form for pretty-printing, and indent being the current
+  ; indent level.
   `(do
        (hash-set pp/special-forms ',name
                  (fn ,args ,@body))
        (dox-add-doc ',name
                     'pp/def
-                    '("pretty-printer for forms starting with ~(quote ,name)")
+                    (list "pretty-printer for forms starting with ~(quote ,name)")
                     ',args
                     '(pp/def ,name ,args ,@body))))
 

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

@@ -1,13 +1,13 @@
-;
-; absurd contrived exaggerated example to test that macros that generate
-; macros that generate macros that generate expressions are likely to work
-;
-; may you never need to do this in real life
-;
+;;
+;; absurd contrived exaggerated example to test that macros that generate
+;; macros that generate macros that generate expressions are likely to work
+;;
+;; may you never need to do this in real life
+;;
 (mac make-make-op (opname op)
   `(mac ,opname (name n . body)
-        `(mac ,name (x)
-              `(,',',op ,,n ,x))))
+     `(mac ,name (x)
+        `(,',',op ,,n ,x))))
 
 (make-make-op make-mult *)
 (make-make-op make-plus +)
@@ -20,253 +20,123 @@
 (make-plus +seven 7)
 (make-plus +eleven 11)
 
-;
-; another contrived example to check deeply nested lexical scoping
-;
+;;
+;; another contrived example to check deeply nested lexical scoping
+;;
 (let test-a0 "a0"
   (def test-foo (f0 f1)
     (with (w0 "w0" w1 "w1" w2 "w2" w3 "w3")
-      (let f (fn (x0) (joinstr " " test-a0 x0 f0 x0 f1))
-        (map f (list w0 w1 w2 w3))))))
-
-(register-test
- '(suite "Boot Tests"
-         (suite "conditionals"
-               ("single-expr 'if is just the expr"
-                (pre-compile '(if a))
-                a)
-
-               ("two-expr 'if expands to 'cond"
-                (pre-compile '(if a b))
-                (cond a b))
-
-               ("three-expr 'if expands to 'cond"
-                (pre-compile '(if a b c))
-                (cond a b c))
-
-               ("four-expr 'if expands to nested 'cond"
-                (pre-compile '(if a b c d))
-                (cond a b (cond c d)))
-
-               ("five-expr 'if expands to nested 'cond"
-                (pre-compile '(if a b c d e))
-                (cond a b (cond c d e)))
-
-               ("'unless expands to 'if"
-                (pre-compile '(unless x y z))
-                (cond (no x) ((fn () y z)))))
-
-         (suite "hashtables"
-                ("build a hash table from brace-list syntax"
-                 (let hsh { foo 1 bar 2 }
-                      (list 'foo hsh.foo 'bar hsh.bar))
-                 (foo 1 bar 2))
-
-                ("single-item brace list is just the thing itself"
-                 (let zi 10 "finds the ~{zi}th item")
-                 "finds the 10th item")
-
-                ("detects key presence"
-                 (hash-key? { foo 1 bar 2 } 'foo)
-                 t)
-
-                ("detects key absence"
-                 (hash-key? { foo 1 bar 2 } 'zed)
-                 nil)
-
-                ("unquotes hash keys"
-                 (with (zi 'foo chi 'bar yi 'grr)
-                      (let hsh { ,zi 10 ,chi 11 ,yi 12 }
-                           (list zi hsh.foo chi hsh.bar yi hsh.grr)))
-                 (foo 10 bar 11 grr 12))
-
-                ("allows literal and invocation hash keys"
-                 (with (zi "hello" chi "world")
-                      (let hsh { (joinstr " " zi chi) 10 "yesterday" 11 }
-                           (list "hello world" (hash-get hsh "hello world") "yesterday" (hash-get hsh "yesterday"))))
-                 ("hello world" 10 "yesterday" 11)))
-
-         (suite "list management"
-                ("'pair breaks a list into pairs"
-                 (pairs '(1 a 2 b 3 c))
-                 ((1 a) (2 b) (3 c)))
-
-                ("'rev reverses a list"
-                 (rev '(a b c))
-                 (c b a))
-
-                ("'rev handles nil"
-                 (rev nil)
-                 nil)
-
-                ("'rev doesn't recurse"
-                 (rev '(a b (c d e) f g))
-                 (g f (c d e) b a))
-
-                ("'flatten returns a flat list of things"
-                 (flatten '((poo (x) (* x x)) (1 2 3)))
-                 (poo x * x x 1 2 3)))
-
-         (suite "map"
-                ("maps a function over a list of numbers"
-                 (map (fn (x) (* x x)) '(1 2 3))
-                 (1 4 9))
-
-                ("maps a string join function over a list of strings"
-                 (test-foo "x" "y")
-                 ("a0 w0 x w0 y" "a0 w1 x w1 y" "a0 w2 x w2 y" "a0 w3 x w3 y"))
-
-                (suite "mapx"
-                  ("provides a convenient simplification for 'map"
-                    (mapx '(1 2 3 4) n (* n 2))
-                    (2 4 6 8))))
-
-         (suite "reduce"
-                ("it applies a function cumulatively over a list"
-                 (reduce + '(1 2 3))
-                 6))
-
-         (suite "detect"
-                ("returns first matching item in a list"
-                 (detect (fn (x) (eq? (len x) 2))
-                         (list "foo" "bar" "xx" "pp"))
-                 "xx")
-
-                ("returns nil when nothing matches"
-                 (detect (fn (x) (eq? (len x) 20))
-                         (list "foo" "bar" "xx" "pp"))
-                 nil)
-
-                ;; kind of pointless
-                ("returns nil if nil is the matching item"
-                 (detect no (list "foo" "bar" nil "pp"))
-                 nil)
-
-                ("returns item if it's an atom and matches"
-                 (detect (fn (x) (eq? (len x) 2)) "zz")
-                 "zz")
-
-                ("returns nil if it's an atom and doesn't match"
-                 (detect (fn (x) (eq? (len x) 20))
-                         "zz")
-                 nil))
-
-         (suite "pre-compile"
-                (suite "bang-syntax"
-                       ("expansion"
-                        (pre-compile '(!eq? a b))
-                        ((fn args (no (apply eq? args))) a b))
-
-                       ("bang-syntax for 'eq?"
-                        (!eq? 1 2)
-                        t)
-
-                       ("bang-syntax for 'caris"
-                        (!caris 'foo '(foo bar))
-                        nil)
-
-                       ("bang-syntax for 'caris"
-                        (!caris 'foo '(zozo foo bar))
-                        t))
-
-                (suite "ampersand-syntax"
-                       ("defines a hash-lookup function"
-                        (pre-compile '&first)
-                        (fn (obj) (hash-get obj (quote first))))
-
-                       ("defines a hash-lookup function with a dot-syntax arg"
-                        (pre-compile '&teacher.address.city)
-                        (fn (obj) (hash-get (hash-get (hash-get obj (quote teacher)) (quote address)) (quote city))) ))
-
-                (suite "colon-syntax"
-                       ("used for composition"
-                        (pre-compile '(no:eq? a b))
-                        ((fn args (no (apply eq? args))) a b))
-
-                       ("used for composition"
-                        (pre-compile '(x:y a b))
-                        ((fn args (x (apply y args))) a b)))
-
-                (suite "bang-colon syntax"
-                       ("special combination with bang"
-                        (pre-compile '(!x:y a b))
-                        ((fn args (no (x (apply y args)))) a b)))
-
-                ("expands 'let"
-                 (do
-                     (def x+3*z (x y)
-                          (let y 3
-                               (fn (z) (* (+ x y) z))))
-                     ((x+3*z 2 99) 5))
-                 25)
-
-                ("expands 'and"
-                 (pre-compile '(and a b c))
-                 (cond a (cond b c)))
-
-                ("expands 'or"
-                 (do (reset-uniq-counter)
-                     (pre-compile '(or a b c)))
-                 ((fn (ora-1)
-                      (cond ora-1
-                            ora-1
-                            ((fn (ora-2)
-                                 (cond ora-2
-                                       ora-2
-                                       ((fn (ora-3)
-                                            (cond ora-3
-                                                  ora-3
-                                                  nil)) c))) b))) a))
-
-                ("w/uniq provides unique variables for macro expansion"
-                 (do (reset-uniq-counter)
-                     (pre-compile '(w/uniq a foo)))
-                 ((fn (a) foo) (uniq 'a)))
-
-                (suite "quasiquote"
-                       ("same as quote for standalone item"
-                        `a
-                        a)
-                       ("same as quote for standalone list"
-                        `(a b c)
-                        (a b c))
-                       ("substitutes single variables"
-                        (let b 10 `(a ,b c))
-                        (a 10 c))
-                       ("substitutes a list"
-                        (let b '(1 2 3) `(a ,@b c))
-                        (a 1 2 3 c))
-                       ("substitutes a list at the end of a given list"
-                        (let b '(1 2 3) `(a ,b ,@b))
-                        (a (1 2 3) 1 2 3))
-                       ("more complicated substitution example"
-                        (with (d '(1 2 3) g '(x y z)) `(a (b c ,d (e f ,@g))))
-                        (a (b c (1 2 3) (e f x y z))))
-                       ("peeks inside nested quotes"
-                        `(a b '(c ,(+ 1 2)))
-                        (a b '(c 3)))
-                       ("handles nested unquote-splicing"
-                        ``(a ,,@(list '+ 1 2) b)
-                        `((a ,(+ 1 2) b)))
-                       ("returns nested quasiquotes"
-                        `(a b `(c d ,(+ 1 2) ,,(+ 3 4)))
-                        (a b `(c d ,(+ 1 2) ,7))))
-
-         (suite "build-keyword-args"
-                ("takes a list of lists and returns the list with the first item of each sublist quoted"
-                 (build-keyword-args '( (a 1) (b c) (d e "f" 22) ))
-                 ((list 'a 1) (list 'b c) (list 'd e "f" 22))))
-
-         (suite "make-macros can create macros"
-                ("make-plus example generates a plus-seven expression"
-                 (+seven 6)
-                 13)
-                ("make-mult example generates a multiply-by-seven expression"
-                 (*seven 6)
-                 42)
-                ("make-mult example generates a multiply-by-eleven expression"
-                 (*eleven 20)
-                 220)
-                ("make-make example expressions can be nested"
-                 (*eleven (*five (+seven 2)))
-                 495))))
+          (let f (fn (x0) (joinstr " " test-a0 x0 f0 x0 f1))
+            (map f (list w0 w1 w2 w3))))))
+
+(examples-for map
+  ("maps a function over a list of numbers"
+   (map (fn (x) (* x x)) '(1 2 3))
+   (1 4 9))
+
+  ("maps a string join function over a list of strings"
+   (test-foo "x" "y")
+   ("a0 w0 x w0 y" "a0 w1 x w1 y" "a0 w2 x w2 y" "a0 w3 x w3 y"))
+
+  (suite "mapx"
+         ("provides a convenient simplification for 'map"
+          (mapx '(1 2 3 4) n (* n 2))
+          (2 4 6 8))))
+
+(examples-for reduce
+  ("it applies a function cumulatively over a list"
+   (reduce + '(1 2 3))
+   6))
+
+(examples-for bang-syntax
+  ("expansion"
+   (pre-compile '(!eq? a b))
+   ((fn args (no (apply eq? args))) a b))
+
+  ("bang-syntax for 'eq?"
+   (!eq? 1 2)
+   t)
+
+  ("bang-syntax for 'caris"
+   (!caris 'foo '(foo bar))
+   nil)
+
+  ("bang-syntax for 'caris"
+   (!caris 'foo '(zozo foo bar))
+   t))
+
+(examples-for ampersand-syntax
+  ("defines a hash-lookup function"
+   (pre-compile '&first)
+   (fn (obj) (hash-get obj (quote first))))
+
+  ("defines a hash-lookup function with a dot-syntax arg"
+   (pre-compile '&teacher.address.city)
+   (fn (obj) (hash-get (hash-get (hash-get obj (quote teacher)) (quote address)) (quote city))) ))
+
+(examples-for colon-syntax
+  ("used for composition"
+   (pre-compile '(no:eq? a b))
+   ((fn args (no (apply eq? args))) a b))
+
+  ("used for composition"
+   (pre-compile '(x:y a b))
+   ((fn args (x (apply y args))) a b))
+
+  ("special combination with bang"
+   (pre-compile '(!x:y a b))
+   ((fn args (no (x (apply y args)))) a b)))
+
+(examples-for let
+  ("expands 'let"
+   (do
+       (def x+3*z (x y)
+         (let y 3
+           (fn (z) (* (+ x y) z))))
+       ((x+3*z 2 99) 5))
+   25))
+
+(examples-for and
+  ("expands 'and"
+   (pre-compile '(and a b c))
+   (cond a (cond b c))))
+
+(examples-for or
+  ("expands 'or"
+   (do (reset-uniq-counter)
+       (pre-compile '(or a b c)))
+   ((fn (ora-1)
+        (cond ora-1
+              ora-1
+              ((fn (ora-2)
+                   (cond ora-2
+                         ora-2
+                         ((fn (ora-3)
+                              (cond ora-3
+                                    ora-3
+                                    nil)) c))) b))) a)))
+
+(examples-for w/uniq
+  ("w/uniq provides unique variables for macro expansion"
+   (do (reset-uniq-counter)
+       (pre-compile '(w/uniq a foo)))
+   ((fn (a) foo) (uniq 'a))))
+
+(examples-for build-keyword-args
+  ("takes a list of lists and returns the list with the first item of each sublist quoted"
+   (build-keyword-args '( (a 1) (b c) (d e "f" 22) ))
+   ((list 'a 1) (list 'b c) (list 'd e "f" 22))))
+
+(examples-for mac
+  ("make-plus example generates a plus-seven expression"
+   (+seven 6)
+   13)
+  ("make-mult example generates a multiply-by-seven expression"
+   (*seven 6)
+   42)
+  ("make-mult example generates a multiply-by-eleven expression"
+   (*eleven 20)
+   220)
+  ("make-make example expressions can be nested"
+   (*eleven (*five (+seven 2)))
+   495))

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

@@ -0,0 +1,16 @@
+(examples-for car
+  ("car of nil is nil"
+   (car nil)
+   nil)
+
+  ("car of empty list is nil"
+   (car '())
+   nil)
+
+  ("car - no need to quote empty list"
+   (car ())
+   nil)
+
+  ("car returns car of argument"
+   (car '(foo 12.34 "bar"))
+   foo))