nydp 0.1.0 → 0.1.1

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: ebd833948c836f583d77adc0028df3838bd30ed3
-  data.tar.gz: 85458c42aa0466e0802771a3a62b3593cc26d25d
+  metadata.gz: 031f54326dfa57ae2a067c931bd600bd9e2cc6c0
+  data.tar.gz: aa49dab4d81173e02e968958028c1cad2948079c
 SHA512:
-  metadata.gz: 6b0981f75b8ecf590694377973f0bc9b013250cd54ad0278d0b79cfba43cc6c8f870f4842238e1df43448fdcfad15a2cb7634c2b30c141b60dbb1bca87a610ee
-  data.tar.gz: cd44bec0ad3c3fe9b1bfc8c38937ac5850de8529b0f74004378bbbae3dbe376d9e39c02ea5db3c1383888b26bcf8f6fea34fc50adf634a1e8a3ef134587d598a
+  metadata.gz: e263b9ce4dff11cd6ac7e7d7ef5787ad553807eb1f2048bbd357973ddbbc910feaaf7c340c0bb8347f31d90e07c4e5b23af3992ed31cb8e61edef8e878c480b5
+  data.tar.gz: 0966de059bcf3658fe137c9a436bf817d84b5bc4ad443b8afd14e22fbecc7e392c23732d6a5a5db8862345bd5ba70b7ae09e87e67e0a910484792e1882e27eda

data/README.md

@@ -275,10 +275,117 @@ error
 nydp > (parse "; blah blah")
 
 ==> (comment "blah blah")
+```
+
+Except in 'mac and 'def forms, by default, `comment` is a macro that expands to nil. If you have a better idea, go for it.
+
+#### 8 Prefix lists
+
+The parser emits a special form if it detects a prefix-list, that is, a list with non-delimiter characters immediately preceding
+the opening delimiter. For example:
+
+```lisp
+nydp > (parse "%w(a b c)")
+
+==> (prefix-list "%w" (a b c))
+```
+
+This allows for preprocessing lists in a way not possible for macros. nydp uses this feature to implement shortcut oneline
+functions, as in
+
+```lisp
+nydp > (parse "λx(len x)")
+
+==> ((prefix-list "λx" (len x)))
+
+nydp > (pre-compile '(prefix-list "λx" (len x)))
+
+==> (fn (x) (len x))
+```
+
+Each character after 'λ becomes a function argument:
+
+```lisp
+nydp > (parse "λxy(* x y)")
+
+==> ((prefix-list "λxy" (* x y)))
+
+nydp > (pre-compile '(prefix-list "λxy" (* x y)))
+
+==> (fn (x y) (* x y))
+```
+
+Use 'define-prefix-list-macro to define a new handler for a prefix-list. Here's the code for the 'λ shortcut:
+
+```lisp
+(define-prefix-list-macro "^λ.+" vars expr
+  (let var-list (map sym (cdr:string-split vars))
+    `(fn ,var-list ,expr)))
+```
+
+In this case, the regex matches an initial 'λ ; there is no constraint however on the kind of regex a prefix-list-macro might use.
+
+
+#### 9 Self-documenting
 
-By default, `comment` is a macro that expands to nil. If you have a better idea, go for it. (doc-comments for example)
+Once the 'dox system is bootstrapped, any further use of 'mac or 'def will create documentation.
+
+Any comments at the start of the form body will be used to generate help text. For example:
+
+```lisp
+nydp > (def foo (x y)
+         ; return the foo of x and y
+         (* x y))
+
+nydp > (dox foo)
+
+Function : foo
+args : (x y)
+return the foo of x and y
+
+source
+======
+(def foo (x y)
+    (* x y))
 ```
 
+'dox is a macro that generates code to output documentation to stdout. 'dox-lookup is a function that returns structured documentation.
+
+```lisp
+nydp > (dox-lookup 'foo)
+((foo def ("return the foo of x and y") (x y) (def foo (x y) (* x y))))
+```
+
+Not as friendly, but more amenable to programmatic manipulation. Each subsequent definition of 'foo (if you override it, define
+it as a macro, or define it again in some other context) will generate a new documentation structure, which will simply be preprended to
+the existing list.
+
+#### 10 Pretty-Printing
+
+'dox above uses the pretty printer to display code source. The pretty-printer is hard-coded to handle some special cases,
+so it will unparse special syntax, prefix-lists, quote, quasiquote, unquote, and unquote-splicing.
+
+You can examine its behaviour at the repl:
+
+```lisp
+nydp > (p:pp '(string-pieces "hello " (bang-syntax || (dot-syntax x y (ampersand-syntax foo bar))) " and welcome to " (prefix-list "%%" (a b c d)) " and friends!"))
+
+==> "hello ~!x.y.foo&bar and welcome to ~%%(a b c d) and friends!"
+
+nydp > (p:pp:dox-src 'pp/find-breaks)
+
+(def pp/find-breaks (form)
+    (if (eq? 'if (car form))
+      (let if-args (cdr form)
+        (cons (list 'if (car if-args)) (map list (cdr if-args))))
+      (or
+        (pp/find-breaks/mac form)
+        (list form))))
+```
+
+The pretty-printer is still rather primitive in that it only indents according to some hard-coded rules, and according to argument-count
+for documented macros. It has no means of wrapping forms that get too long, or that extend beyond a certain predefined margin or column number.
+
 ## Installation
 
 Add this line to your application's Gemfile:

data/lib/lisp/core-000.nydp

@@ -0,0 +1,18 @@
+; -*- lisp -*-
+;;
+;; Acknowledgements to Paul Graham, Robert Morris, and their ancestor programmers.
+;; nydp's main inspiration is arc, and many nydp features (including, but not limited
+;; to, 'do, 'rfn, 'loop, 'for) were directly inspired by (aka stolen from) arc.arc
+;;
+
+(assign   list (fn args args))
+(assign   caar (fn (arg) (car (car arg))))
+(assign   cadr (fn (arg) (car (cdr arg))))
+(assign   cdar (fn (arg) (cdr (car arg))))
+(assign   cddr (fn (arg) (cdr (cdr arg))))
+(assign  cadar (fn (arg) (car (cdr (car arg)))))
+(assign  caddr (fn (arg) (car (cdr (cdr arg)))))
+(assign  cdddr (fn (arg) (cdr (cdr (cdr arg)))))
+(assign cadddr (fn (arg) (car (cdr (cdr (cdr arg))))))
+(assign     no (fn (arg) (cond arg nil t)))
+(assign   just (fn (arg) arg))

data/lib/lisp/{core-01-precompile.nydp → core-010-precompile.nydp}

@@ -42,6 +42,7 @@
 
 (debug-pre-compile nil)
 
+; we override this later to provide automatic documentation
 (hash-set macs 'def
           (fn (name args . body)
               (list 'assign
@@ -118,13 +119,6 @@
 (hash-set macs 'quasiquote
           (fn (arg) (qq-quasiquote arg 0)))
 
-(hash-set macs 'mac (fn (name args . body)
-  `(hash-set macs ',name (fn ,args ,@body))))
-
-(mac if args
-     (cond (no args) nil
-           (cond (cdr args)
-                 (cond (cddr args)
-                       `(cond ,(car args) ,(cadr args) (if ,@(cddr args)))
-                       `(cond ,(car args) ,(cadr args)))
-                 (car args))))
+(hash-set macs 'do
+          (fn args
+              `((fn nil ,@args))))

data/lib/lisp/core-015-documentation.nydp

@@ -0,0 +1,89 @@
+((fn (dox)
+     (def dox-add-doc (name what texts args src)
+       (hash-set dox
+                 name
+                 (cons (list name what texts args src)
+                       (hash-get dox sym))))
+
+     (def dox-lookup (sym) (hash-get dox sym))
+
+     (def dox? (sym) (hash-key? dox sym))
+
+     (def dox-names () (hash-keys dox))
+
+     (def dox-what-is? (name)
+       (cond (dox? name)
+             (cadr (car (dox-lookup name)))))
+
+     (def dox-src (name)
+       (cond (dox? name)
+             (car (cddr (cddr (car (dox-lookup name)))))))
+
+     (def dox-arg-names (name)
+       (cond (dox? name)
+             (cadddr (car (dox-lookup name))))))
+ (hash))
+
+(def isa-comment? (thing)
+  (cond (pair? thing)
+        (eq? (car thing) 'comment)))
+
+(def rev-accum (things acc)
+  (cond (no things)
+        acc
+        (rev-accum (cdr things)
+                   (cons (car things)
+                         acc))))
+
+(def rev (things) (rev-accum things nil))
+
+(def dox-gather-comments (body acc)
+  (cond (isa-comment? (car body))
+        (dox-gather-comments (cdr body)
+                             (cons (cadar body)
+                                   acc))
+        (list (rev acc) body)))
+
+(def define-mac-expr (name args documentation body)
+  ; used internally by 'mac
+  `(do (hash-set macs ',name (fn ,args ,@body))
+       (dox-add-doc ',name
+                    'mac
+                    ',documentation
+                    ',args
+                    '(mac ,name ,args ,@body))))
+
+(hash-set macs 'mac
+          (fn (name args . body)
+              (apply define-mac-expr
+                     name
+                     args
+                     (dox-gather-comments body))))
+
+(dox-add-doc 'mac
+             'mac
+             '("define a new global macro")
+             '(name args . body)
+             (dox-src 'define-mac-expr))
+
+(dox-add-doc 'do
+             'mac
+             '("perform a series of operations")
+             'args
+             '`((fn nil ,@args)))
+
+(def define-def-expr (name args documentation body)
+  ; used internally by 'def
+  `(do (assign ,name (fn ,args ,@body))
+       (dox-add-doc ',name
+                    'def
+                    ',documentation
+                    ',args
+                    '(def ,name ,args ,@body))))
+
+(mac def (name args . body)
+  ; define a new function in the global namespace
+  (apply define-def-expr
+         name
+         args
+         (dox-gather-comments body)))

data/lib/lisp/core-020-utils.nydp

@@ -0,0 +1,22 @@
+(mac if args
+  ; with arguments a,         return a
+  ; with arguments a b,       return b if a is true, otherwise nil
+  ; with arguments a b c,     return b if a is true, otherwise return c
+  ; with arguments a b c d,   return b if a is true, otherwise return d if c is true, otherwise nil
+  ; with arguments a b c d e, return b if a is true, otherwise return d if c is true, otherwise e
+  ; and so on for subsequent arguments
+  (cond (no args) nil
+        (cond (cdr args)
+              (cond (cddr args)
+                    `(cond ,(car args) ,(cadr args) (if ,@(cddr args)))
+                    `(cond ,(car args) ,(cadr args)))
+              (car args))))
+
+(def map (f things)
+  ; transforms the list 'things by applying 'f to each item
+  ; returns the resulting list
+  (if (no things)
+      nil
+      (pair? things)
+      (cons (f (car things)) (map f (cdr things)))
+      (map f (list things))))

data/lib/lisp/{core-03-syntax.nydp → core-030-syntax.nydp}

@@ -27,9 +27,6 @@
           (car args))
       't))
 
-(mac do args
-  `((fn nil ,@args)))
-
 (mac when (condition . body)
   `(cond ,condition (do ,@body)))
 
@@ -84,9 +81,8 @@
           name)
       (list 'quote name)))
 
-;; (build-hash-getters '(a b c))
-;; => (hash-get (hash-get a 'b) 'c)
 (def build-hash-getters (names acc)
+  ;; (build-hash-getters '(a b c)) => (hash-get (hash-get a 'b) 'c)
   (if (no acc)
       (build-hash-getters (cdr names) (car names))
       names

data/lib/lisp/{core-04-utils.nydp → core-040-utils.nydp}

@@ -4,18 +4,11 @@
        (f (car things))))
 
 (def zip (a b)
+  ; takes two lists, (p q r) and (1 2 3), returns ((p 1) (q 2) (r 3))
   (if a
       (cons (list (car a) (car b))
             (zip (cdr a) (cdr b)))))
 
-(def reversify (things acc)
-  (if (no things)
-      acc
-      (reversify (cdr things)
-                 (cons (car things) acc))))
-
-(def rev (things) (reversify things nil))
-
 (mac push (x things)
   `(assign ,things (cons ,x ,things)))
 
@@ -29,6 +22,13 @@
                (flattenize things))
           acc))
 
+(def string-strip (txt)
+  (string-replace "\\s+$"
+                  ""
+                  (string-replace "^\\s+"
+                                  ""
+                                  txt)))
+
 (def joinstr (txt . things)
      (let joinables (flatten things)
        (apply +
@@ -60,6 +60,7 @@
               (iso (car x) (car y))
               (iso (cdr x) (cdr y)))))
 
+(def x1      (thing)    thing)
 (def isa     (type obj) (eq? (type-of obj) type))
 (def sym?    (arg)      (isa 'symbol arg))
 (def string? (arg)      (isa 'string arg))
@@ -141,3 +142,51 @@
                 (cdr list))
             acc))
    (car things) (cdr things)))
+
+(def dox-show-src (src)
+  ; show 'src as source code.
+  ; expect to override this later when pretty-printing is available
+  (inspect src))
+
+(def dox-show-info (name what texts args src)
+  ; show the given dox info
+  ; 'info arg is a dox object from the dox system
+  (p)
+  (cond (eq? what 'mac) (p "Macro : ~name"    ))
+  (cond (eq? what 'def) (p "Function : ~name" ))
+  (p "args : ~(inspect args)")
+  (p (joinstr "\n" texts))
+  (p "")
+  (p "source")
+  (p "======")
+  (p (dox-show-src src))
+  (p))
+
+(mac dox (name)
+  ; show dox for the given name
+  `(let infos (dox-lookup ',name)
+     (if (or (no infos)
+             (eq? (len infos) 0))
+         (p "No documentation for " ',name)
+         (each info infos
+               (apply dox-show-info info)))))
+
+(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))

data/lib/lisp/core-070-prefix-list.nydp

@@ -0,0 +1,33 @@
+
+(assign prefix-list-prefixes ())
+
+(def prefix-match-fn (txt)
+  (fn (rule) (string-match txt (car rule))))
+
+(def find-prefix-rule (prefix)
+  (cdr:detect (prefix-match-fn prefix)
+        prefix-list-prefixes))
+
+(mac prefix-list (prefix list)
+  ; looks up a handler in 'prefix-list-prefixes
+  ; whose 'car matches the prefix, and whose 'cdr
+  ; is a function, which behaves like a macro, in that
+  ; it processes the prefix name and the prefixed list,
+  ; returning more code
+  (let handler (find-prefix-rule prefix)
+    (and handler (handler prefix list))))
+
+(mac define-prefix-list-macro (regex prefix-var list-var . body)
+  ; define a macro to process a prefix-list where the prefix matches the given regex
+  ; param: 'regex is the regex which should match the list prefix
+  ; param: 'prefix-var is the variable whose value will be the actual matched prefix
+  ; param: 'list-var is the variable whose value will be the corresponding list
+  ; param: 'body the code which will actually transform the list
+  `(push (cons ,regex (fn (,prefix-var ,list-var) ,@body))
+         prefix-list-prefixes))
+
+(define-prefix-list-macro "^λ.+" vars expr
+  ;; allows (map λa(upcase a.name) people)
+  ;; as shortcut for (map (fn (a) (upcase a.name)) people)
+  (let var-list (map sym (cdr:string-split vars))
+    `(fn ,var-list ,expr)))

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

@@ -0,0 +1,101 @@
+(assign pp/special-forms (hash))
+(assign pp/line-break (uniq 'line-break))
+
+(def pp/escape-char (char)
+  (if (eq? char "\"") "\\\""
+      (eq? char "\~") "\\\~"
+      (eq? char "\\") "\\\\"
+      (eq? char "\n") "\\n"
+      char))
+
+(def pp/escape-string-literal (txt)
+  (joinstr "" (map pp/escape-char (string-split txt))))
+
+(def pp/string-piece (thing)
+  (if (isa 'string thing) (pp/escape-string-literal thing)
+      "\~~(pp thing)"))
+
+(def pp/string-pieces (things) "\"~(joinstr "" (map pp/string-piece things))\"")
+
+(def pp/literal (thing)
+  (if (eq? thing '||)
+      ""
+      (isa 'string thing)
+      (pp/escape-string-literal thing)
+      (inspect thing)))
+
+(mac pp/def (name args . body)
+  `(do
+       (hash-set pp/special-forms ',name
+                 (fn ,args ,@body))
+       (dox-add-doc ',name
+                    'pp/def
+                    '("pretty-printer for forms starting with ~(quote ,name)")
+                    ',args
+                    '(pp/def ,name ,args ,@body))))
+
+(mac pp/syntax syntaxes
+  (if syntaxes
+      `(do (pp/def ,(car syntaxes) (form indent)
+                   (joinstr ,(cadr syntaxes) (map pp (cdr form))))
+           (pp/syntax ,@(cddr syntaxes)))))
+
+(pp/def string-pieces    (form indent) (pp/string-pieces (cdr form)))
+(pp/def quasiquote       (form indent) "`~(pp/main (cadr form) indent)" )
+(pp/def quote            (form indent) "'~(pp/main (cadr form) indent)" )
+(pp/def unquote          (form indent) ",~(pp/main (cadr form) indent)" )
+(pp/def unquote-splicing (form indent) ",@~(pp/main (cadr form) indent)")
+(pp/def comment          (form indent) ";~(cadr form)\n")
+(pp/def prefix-list      (form indent) "~(cadr form)~(pp (caddr form))")
+
+(pp/syntax
+ colon-syntax ":"
+ dot-syntax   "."
+ bang-syntax  "!"
+ ampersand-syntax "&"
+ dollar-syntax "$"
+ colon-colon-syntax "::"
+ arrow-syntax "->"
+ rocket-syntax "=>" )
+
+(def pp/spaces (n) (if (> n 0) " ~(pp/spaces (- n 1))" ""))
+
+(def pp/dotify (form)
+  (if (pair? (cdr form))
+      (cons (car form) (pp/dotify (cdr form)))
+      (no:cdr form)
+      form
+      (list (car form) '. (cdr form))))
+
+(def pp/find-breaks/mac (form)
+  (if (eq? (dox-what-is? (car form)) 'mac)
+      (let arg-count (+ 1 (len (dox-arg-names (car form))))
+        (cons (firstn arg-count form)
+              (map list (nthcdr arg-count form))))))
+
+(def pp/find-breaks (form)
+  (if (eq? 'if (car form))
+      (let if-args (cdr form)
+        (cons (list 'if (car if-args)) (map list (cdr if-args))))
+      (or (pp/find-breaks/mac form)
+          (list form))))
+
+(def pp/inline (forms indent)
+  (joinstr " " (map λf(pp/main f (+ indent 1)) forms)))
+
+(def pp/pair (form indent)
+  (let special-form (hash-get pp/special-forms (car form))
+    (if special-form
+        (special-form form indent)
+        (let form-with-breaks (pp/find-breaks form)
+          "(~(joinstr "\n~(pp/spaces (+ 4 indent))" (map λf(pp/inline f (+ indent 1)) (pp/dotify form-with-breaks))))"))))
+
+(def pp/main (form indent)
+  (if (pair? form) (pp/pair form indent)
+      (pp/literal form)))
+
+(def pp (form) (pp/main form 0))
+
+(def dox-show-src (src)
+  ; use the pretty-printer to elegantly display the given source code
+  (pp src))

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

@@ -66,6 +66,14 @@
                  (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 }
@@ -78,11 +86,6 @@
                            (list "hello world" (hash-get hsh "hello world") "yesterday" (hash-get hsh "yesterday"))))
                  ("hello world" 10 "yesterday" 11)))
 
-         (suite "strings"
-                ("length"
-                 (len "foo-bar")
-                 7))
-
          (suite "list management"
                 ("'pair breaks a list into pairs"
                  (pairs '(1 a 2 b 3 c))
@@ -100,26 +103,6 @@
                  (rev '(a b (c d e) f g))
                  (g f (c d e) b a))
 
-                ("joins elements into a string"
-                 (joinstr "" '("foo" "bar" "bax"))
-                 "foobarbax")
-
-                ("joins separate elements into a string"
-                 (joinstr "/" "foo" "bar" "bax")
-                 "foo/bar/bax")
-
-                ("joins a single thing"
-                 (joinstr "/" "foo")
-                 "foo")
-
-                ("joins nested and separate elements into a string"
-                 (joinstr "/" "foo" "bar" '(twiddle diddle) "bax")
-                 "foo/bar/twiddle/diddle/bax")
-
-                ("joins elements into a string"
-                 (joinstr " - " '(1 2 3))
-                 "1 - 2 - 3")
-
                 ("'flatten returns a flat list of things"
                  (flatten '((poo (x) (* x x)) (1 2 3)))
                  (poo x * x x 1 2 3)))

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

@@ -0,0 +1,103 @@
+(mac this-is-a-well-documented-macro (a b c)
+  ; documentation for me!
+  `(foo ,a ,b ,c))
+
+(mac this-is-an-undocumented-macro (a b c)
+  `(baz ,a ,b ,c))
+
+(def this-is-a-well-documented-def (a b c)
+  ; documentation for me!
+  (foo a b c))
+
+(def this-is-an-undocumented-def (a b c)
+  (baz a b c))
+
+(register-test
+ '(suite "Documentation Tests"
+         (suite "comment detection"
+                ("identify comment"
+                 (isa-comment? '(comment "yes, it is"))
+                 t)
+
+                ("identify non-comment"
+                 (isa-comment? "not this time")
+                 nil))
+
+         (suite "gather comments from 'body argument"
+                ("no comment"
+                 (dox-gather-comments '((this) (that)))
+                 (nil ((this) (that))))
+
+                ("one comment"
+                 (dox-gather-comments '((comment "hello") (this) (that)))
+                 (("hello") ((this) (that))))
+
+                ("more comments"
+                 (dox-gather-comments '((comment "hello")
+                                        (comment "more details")
+                                        (comment "very rigourous")
+                                        (this)
+                                        (that)))
+                 (("hello" "more details" "very rigourous") ((this) (that)))))
+
+         (suite "mac"
+                ("a documented macro"
+                 (dox-lookup 'this-is-a-well-documented-macro)
+                 ((this-is-a-well-documented-macro
+                   mac
+                   ("documentation for me!")
+                   (a b c)
+                   (mac this-is-a-well-documented-macro (a b c)
+                     `(foo ,a ,b ,c)))))
+
+                ("arg list"
+                 (dox-arg-names 'this-is-a-well-documented-macro)
+                 (a b c))
+
+                ("src"
+                 (dox-src 'this-is-a-well-documented-macro)
+                 (mac this-is-a-well-documented-macro (a b c) (quasiquote (foo (unquote a) (unquote b) (unquote c)))))
+
+                ("is a def"
+                 (dox-what-is? 'this-is-a-well-documented-macro)
+                 mac)
+
+                ("an undocumented macro"
+                 (dox-lookup 'this-is-an-undocumented-macro)
+                 ((this-is-an-undocumented-macro
+                   mac
+                   nil
+                   (a b c)
+                   (mac this-is-an-undocumented-macro (a b c)
+                     `(baz ,a ,b ,c)))))
+
+         (suite "def"
+                ("a documented def"
+                 (dox-lookup 'this-is-a-well-documented-def)
+                 ((this-is-a-well-documented-def
+                   def
+                   ("documentation for me!")
+                   (a b c)
+                   (def this-is-a-well-documented-def (a b c)
+                     (foo a b c)))))
+
+                ("arg list"
+                 (dox-arg-names 'this-is-a-well-documented-def)
+                 (a b c))
+
+                ("is a def"
+                 (dox-what-is? 'this-is-a-well-documented-def)
+                 def)
+
+                ("src"
+                 (dox-src 'this-is-a-well-documented-def)
+                 (def this-is-a-well-documented-def (a b c) (foo a b c)))
+
+                ("an undocumented def"
+                 (dox-lookup 'this-is-an-undocumented-def)
+                 ((this-is-an-undocumented-def
+                   def
+                   nil
+                   (a b c)
+                   (def this-is-an-undocumented-def (a b c)
+                     (baz a b c)))))))))

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

@@ -0,0 +1,66 @@
+(register-test
+ '(suite "List Tests"
+         (suite "firstn"
+                ("returns no items for n = 0"
+                 (firstn 0 '(a b c d))
+                 nil)
+
+                ("returns first n items for n > 0 and n < size of list"
+                 (firstn 3 '(a b c d e))
+                 (a b c))
+
+                ("returns all items for n > size of list"
+                 (firstn 33 '(a b c d e))
+                 (a b c d e)))
+
+         (suite "nthcdr"
+                ("returns all items for n = 0"
+                 (nthcdr 0 '(a b c d))
+                 (a b c d))
+
+                ("returns nth cdr of list for n > 0 and n < size of list"
+                 (nthcdr 3 '(a b c d e))
+                 (d e))
+
+                ("returns nothing for n > size of list"
+                 (nthcdr 33 '(a b c d e))
+                 nil))
+
+         (suite "car/cdr combinations"
+                ("caar of list"   (caar '((x y) (1 2)))   x     )
+                ("caar of nil"    (caar nil)              nil   )
+                ("cadr of list"   (cadr '((x y) (1 2)))   (1 2) )
+                ("cadr of nil"    (cadr nil)              nil   )
+                ("cdar of list"   (cdar '((x y) (1 2)))   (y)   )
+                ("cdar of nil"    (cdar nil)              nil   )
+                ("cddr of list"   (cddr '(x y 1 2))       (1 2) )
+                ("cddr of nil"    (cddr nil)              nil   )
+                ("cadar of list"  (cadar '((x y) (1 2)))  y     )
+                ("cadar of nil"   (cadar nil)             nil   )
+                ("caddr of list"  (caddr '(x y 1 2))      1     )
+                ("caddr of nil"   (caddr nil)             nil   )
+                ("cdddr of list"  (cdddr '(x y 1 2))      (2)   )
+                ("cdddr of nil"   (cdddr nil)             nil   )
+                ("cadddr of list" (cadddr '(x y 1 2 3))   2     )
+                ("cadddr of nil"  (cadddr nil)            nil   ))
+
+         (suite "proper?"
+                ("t for a proper list"
+                 (proper? '(a b c d))
+                 t)
+
+                ("t for a proper list, even if we write it funny"
+                 (proper? '(a b . (c d)))
+                 t)
+
+                ("t for a proper list, even if we write it funny with nil"
+                 (proper? '(a b . nil))
+                 t)
+
+                ("nil for an improper list"
+                 (proper? '(a b . c))
+                 nil)
+
+                ("nil for a very improper list"
+                 (proper? '(a b . (c . d)))
+                 nil))))

data/lib/lisp/tests/pretty-print-tests.nydp

@@ -0,0 +1,25 @@
+(register-test
+ '(suite "Pretty Printing Tests"
+         ("a macro invocation"
+          (pp '(mac pp/def (name args . body) `(hash-set pp/special-forms ',name (fn ,args ,@body))))
+          "(mac pp/def (name args body)\n    `(hash-set pp/special-forms ',name (fn ,args ,@body)))")
+
+         ("a 'def invocation"
+          (pp '(def pp (form) (pp/main form 0)))
+          "(def pp (form)\n    (pp/main form 0))")
+
+         ("combined with dox system"
+          (pp:dox-src 'pp/find-breaks)
+          "(def pp/find-breaks (form)
+    (if (eq? 'if (car form))
+      (let if-args (cdr form)
+        (cons (list 'if (car if-args)) (map list (cdr if-args))))
+      (or
+        (pp/find-breaks/mac form)
+        (list form))))")
+
+         ("special syntax"
+          (pp '(string-pieces "hello " (bang-syntax || (dot-syntax x y (ampersand-syntax foo bar))) " and welcome to " (prefix-list "%%" (a b c d)) " and friends!"))
+          "\"hello ~~!x.y.foo&bar and welcome to ~~%%(a b c d) and friends!\"")
+
+))

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

@@ -0,0 +1,31 @@
+(register-test
+ '(suite "String Tests"
+         (suite "length"
+                ("nonzero"  (len "foo-bar")  7)
+                ("zero"     (len "")         0))
+
+         (suite "joinstr"
+                ("joins elements into a string"
+                 (joinstr "" '("foo" "bar" "bax"))
+                 "foobarbax")
+
+                ("joins separate elements into a string"
+                 (joinstr "/" "foo" "bar" "bax")
+                 "foo/bar/bax")
+
+                ("joins a single thing"
+                 (joinstr "/" "foo")
+                 "foo")
+
+                ("joins nested and separate elements into a string"
+                 (joinstr "/" "foo" "bar" '(twiddle diddle) "bax")
+                 "foo/bar/twiddle/diddle/bax")
+
+                ("joins elements into a string"
+                 (joinstr " - " '(1 2 3))
+                 "1 - 2 - 3"))
+
+         (suite "strip"
+                ("removes leading whitespace"               (string-strip "    hello!")  "hello!" )
+                ("removes trailing whitespace"              (string-strip "(world)   ") "(world)" )
+                ("removes leading and trailing whitespace"  (string-strip "\n\nme\n\n") "me"      ))))

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

@@ -0,0 +1,7 @@
+(register-test '(suite "pair to-string"
+  ("unquote"           (to-string '(unquote a))          ",a"           )
+  ("quote"             (to-string '(quote a))            "'a"           )
+  ("quasiquote"        (to-string '(quasiquote a))       "`a"           )
+  ("unquote-splicing"  (to-string '(unquote-splicing a)) ",@a"          )
+  ("brace-list"        (to-string '(brace-list a b c d)) "{ a b c d }"  )
+))

data/lib/nydp/builtin/hash.rb

@@ -74,6 +74,24 @@ class Nydp::Builtin::HashKeys
   end
 end
 
+class Nydp::Builtin::HashKeyPresent
+  include Nydp::Helper, Nydp::Builtin::Base
+  attr_accessor :ns
+  def initialize ns ; @ns = ns; end
+  def builtin_invoke vm, args
+    hash = args.car
+    key  = args.cdr.car
+    truth = case hash
+            when Nydp::Hash
+              hash.key? key
+            else
+              hash.key? n2r key
+            end
+    vm.push_arg(truth ? Nydp.T : Nydp.NIL)
+  end
+  def name ; "hash-key?" ; end
+end
+
 class Nydp::Builtin::HashMerge
   include Nydp::Helper, Nydp::Builtin::Base
 

data/lib/nydp/builtin/puts.rb

@@ -2,8 +2,12 @@ class Nydp::Builtin::Puts
   include Nydp::Builtin::Base
 
   def builtin_invoke vm, args
-    s = args.map { |a| a.to_s }
-    puts s.join ' '
+    if Nydp.NIL.is? args
+      puts
+    else
+      s = args.map { |a| a.to_s }
+      puts s.join ' '
+    end
     vm.push_arg args.car
   end
 

data/lib/nydp/core.rb

@@ -63,6 +63,7 @@ module Nydp
       Symbol.mk(:"hash-get",    ns).assign(Nydp::Builtin::HashGet.new ns)
       Symbol.mk(:"hash-set",    ns).assign(Nydp::Builtin::HashSet.new)
       Symbol.mk(:"hash-keys",   ns).assign(Nydp::Builtin::HashKeys.new(ns))
+      Symbol.mk(:"hash-key?",   ns).assign(Nydp::Builtin::HashKeyPresent.new(ns))
       Symbol.mk(:"hash-merge",  ns).assign(Nydp::Builtin::HashMerge.new)
       Symbol.mk(:"vm-info",     ns).assign Nydp::Builtin::VmInfo.new
       Symbol.mk(:"pre-compile", ns).assign Nydp::Builtin::PreCompile.new

data/lib/nydp/hash.rb

@@ -3,15 +3,8 @@ class Nydp::Hash < ::Hash
 
   def nydp_type ; :hash   ; end
   def to_ruby
-    @_ruby_hash ||= Hash.new { |h, k|
-      self[case k
-           when String
-             Nydp::StringAtom.new(k)
-           when Symbol
-             Nydp::Symbol.new(k)
-           else
-             k
-           end]
-    }
+    h = Hash.new
+    self.each { |k,v| h[n2r k] = n2r v }
+    h
   end
 end

data/lib/nydp/pair.rb

@@ -75,6 +75,12 @@ class Nydp::Pair
       else
         "'#{cdr.to_s}"
       end
+    elsif car.is_a?(Nydp::Symbol) && car.is?(:"brace-list")
+      if Nydp.NIL.is? cdr.cdr
+        "{}"
+      else
+        "{ #{cdr.to_s_rest} }"
+      end
     elsif car.is_a?(Nydp::Symbol) && car.is?(:quasiquote)
       if Nydp.NIL.is? cdr.cdr
         "`#{cdr.car.to_s}"

data/lib/nydp/parser.rb

@@ -105,7 +105,7 @@ module Nydp
       when :symbol
         parse_symbol token.last
       when :comment
-        Pair.from_list [sym(:comment), token.last]
+        Pair.from_list [sym(:comment), Nydp::StringAtom.new(token.last)]
       else
         token.last
       end

data/lib/nydp/version.rb

@@ -1,3 +1,3 @@
 module Nydp
-  VERSION = "0.1.0"
+  VERSION = "0.1.1"
 end

data/spec/hash_spec.rb

@@ -24,6 +24,7 @@ describe Nydp::Hash do
 
       rhash = hash.to_ruby
       expect(rhash[:boo]).to eq 42
+      expect(rhash.keys) .to eq [:boo]
     end
 
     it "converts ruby string key to nydp string key" do
@@ -32,6 +33,7 @@ describe Nydp::Hash do
 
       rhash = hash.to_ruby
       expect(rhash["boo"]).to eq 42
+      expect(rhash.keys) .to eq ["boo"]
     end
 
     it "uses integer keys unconverted" do
@@ -40,6 +42,7 @@ describe Nydp::Hash do
 
       rhash = hash.to_ruby
       expect(rhash[21]).to eq 42
+      expect(rhash.keys) .to eq [21]
     end
   end
 
@@ -92,6 +95,28 @@ describe Nydp::Hash do
       end
     end
 
+    describe "key?" do
+      it "returns t when key is present" do
+        h    = Nydp::Hash.new
+        k    = sym "jerry"
+        v    = 42
+        h[k] = v
+
+        Nydp::Builtin::HashKeyPresent.new(ns).invoke vm, pair_list([h, k])
+
+        expect(vm.pop_arg).to eq Nydp.T
+      end
+
+      it "returns nil when key is absent" do
+        h    = Nydp::Hash.new
+        k    = sym "benjamin"
+
+        Nydp::Builtin::HashKeyPresent.new(ns).invoke vm, pair_list([h, k])
+
+        expect(vm.pop_arg).to eq Nydp.NIL
+      end
+    end
+
     describe "hash keys" do
       it "returns a list of keys" do
         h    = Nydp::Hash.new
@@ -154,6 +179,27 @@ describe Nydp::Hash do
       end
     end
 
+    describe "key?" do
+      it "returns t when key is present" do
+        ahash[:simon] = 24
+        k             = sym("simon")
+        args          = [ ahash, k ]
+
+        Nydp::Builtin::HashKeyPresent.new(ns).invoke vm, pair_list(args)
+
+        expect(vm.pop_arg).to eq Nydp.T
+      end
+
+      it "returns nil when key is absent" do
+        k             = sym("simon")
+        args          = [ ahash, k ]
+
+        Nydp::Builtin::HashKeyPresent.new(ns).invoke vm, pair_list(args)
+
+        expect(vm.pop_arg).to eq Nydp.NIL
+      end
+    end
+
     describe "hash keys" do
       it "returns a list of keys" do
         ahash[:k0] = 42

data/spec/pair_spec.rb

@@ -8,6 +8,14 @@ describe Nydp::Pair do
   let(:foo)              { Nydp::Symbol.mk :foo,                ns }
   let(:dot)              { Nydp::Symbol.mk ".".to_sym,          ns }
 
+  describe "#map" do
+    it "behaves like ruby #map" do
+      list = pair_list [1,2,3]
+      mapped = list.map { |x| x * 2 }
+      expect(mapped).to eq [2,4,6]
+    end
+  end
+
   describe :== do
     it "should be true for two empty lists" do
       expect(Nydp::Pair.new(NIL, NIL)).to eq Nydp::Pair.new(NIL, NIL)

metadata

@@ -1,14 +1,14 @@
 --- !ruby/object:Gem::Specification
 name: nydp
 version: !ruby/object:Gem::Version
-  version: 0.1.0
+  version: 0.1.1
 platform: ruby
 authors:
 - Conan Dalton
 autorequire: 
 bindir: bin
 cert_chain: []
-date: 2015-10-09 00:00:00.000000000 Z
+date: 2015-10-18 00:00:00.000000000 Z
 dependencies:
 - !ruby/object:Gem::Dependency
   name: bundler
@@ -84,23 +84,30 @@ files:
 - Rakefile
 - bin/nydp
 - bin/nydp-tests
-- lib/lisp/core-00.nydp
-- lib/lisp/core-01-precompile.nydp
-- lib/lisp/core-02-utils.nydp
-- lib/lisp/core-03-syntax.nydp
-- lib/lisp/core-04-utils.nydp
-- lib/lisp/core-05-test-runner.nydp
-- lib/lisp/core-06-benchmarking.nydp
-- lib/lisp/core-07-prefix-list.nydp
+- lib/lisp/core-000.nydp
+- lib/lisp/core-010-precompile.nydp
+- lib/lisp/core-015-documentation.nydp
+- lib/lisp/core-020-utils.nydp
+- lib/lisp/core-030-syntax.nydp
+- lib/lisp/core-040-utils.nydp
+- lib/lisp/core-050-test-runner.nydp
+- lib/lisp/core-060-benchmarking.nydp
+- lib/lisp/core-070-prefix-list.nydp
+- lib/lisp/core-080-pretty-print.nydp
 - lib/lisp/tests/boot-tests.nydp
 - lib/lisp/tests/builtin-tests.nydp
+- lib/lisp/tests/dox-tests.nydp
 - lib/lisp/tests/dynamic-scope-test.nydp
 - lib/lisp/tests/each-tests.nydp
 - lib/lisp/tests/error-tests.nydp
 - lib/lisp/tests/foundation-test.nydp
 - lib/lisp/tests/invocation-tests.nydp
+- lib/lisp/tests/list-tests.nydp
 - lib/lisp/tests/parser-tests.nydp
+- lib/lisp/tests/pretty-print-tests.nydp
+- lib/lisp/tests/string-tests.nydp
 - lib/lisp/tests/syntax-tests.nydp
+- lib/lisp/tests/unparse-tests.nydp
 - lib/nydp.rb
 - lib/nydp/assignment.rb
 - lib/nydp/builtin.rb

data/lib/lisp/core-00.nydp

@@ -1,13 +0,0 @@
-; -*- lisp -*-
-;;
-;; Acknowledgements to Paul Graham. Some nydp features (including,
-;; but not limited to, 'do, 'rfn, 'loop, 'for) are stolen directly from arc.arc
-;;
-
-(assign list  (fn args args))
-(assign caar  (fn (arg) (car (car arg))))
-(assign cadr  (fn (arg) (car (cdr arg))))
-(assign cdar  (fn (arg) (cdr (car arg))))
-(assign cddr  (fn (arg) (cdr (cdr arg))))
-(assign   no  (fn (arg) (cond arg nil t)))
-(assign just  (fn (arg) arg))

data/lib/lisp/core-02-utils.nydp

@@ -1,6 +0,0 @@
-(def map (f things)
-  (if (no things)
-      nil
-      (pair? things)
-      (cons (f (car things)) (map f (cdr things)))
-      (map f (list things))))

data/lib/lisp/core-07-prefix-list.nydp

@@ -1,26 +0,0 @@
-
-(assign prefix-list-prefixes ())
-
-(def prefix-match-fn (txt)
-  (fn (rule) (string-match txt (car rule))))
-
-(def find-prefix-rule (prefix)
-  (cdr:detect (prefix-match-fn prefix)
-        prefix-list-prefixes))
-
-(mac prefix-list (prefix list)
-  (let handler (find-prefix-rule prefix)
-    (and handler (handler prefix list))))
-
-(mac define-prefix-list-macro (regex prefix-var list-var . body)
-  `(push (cons ,regex (fn (,prefix-var ,list-var) ,@body))
-         prefix-list-prefixes))
-
-;;
-;; so you can write (map λa(upcase a.name) people)
-;;
-;; instead of (map (fn (a) (upcase a.name)) people)
-;;
-(define-prefix-list-macro "^λ.+" vars expr
-  (let var-list (map sym (cdr:string-split vars))
-    `(fn ,var-list ,expr)))