nydp 0.2.1 → 0.2.2

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: f085b808304453eb137f0660f08359d1ff6c540f
-  data.tar.gz: 534eaffd255ebc2b1f5c665843995753182bab95
+  metadata.gz: 0efb226f96102a49ecfc52dcd363de20d26a7f3f
+  data.tar.gz: f8423c03ffc9f016396d9daf7934f6a3e5df133d
 SHA512:
-  metadata.gz: 6698547343c2b0b0b3744504323460c0128ee004cff02a701173a931f293bed5c820ba1e75392969a7fad6ac80997ca5e9a30fe737fb5eff2e76e4fdfb85b6b8
-  data.tar.gz: 66870fc5bf0bbeb8b5887f14338ecf2fa44e511005a8c494b5e4f34d4d75af80b97e25b6632aadd988a3676709a174550348ea30f9c93c6fabc005623eb6abe3
+  metadata.gz: b5c3030351ffef2de2d5e922f1f75c4639ca0ef7a616301335b7c015c172461865421502c0615bd594186702f6fe29244a14ae25a1c9959913a5d457d6eabd9f
+  data.tar.gz: 87d733099303526473ef61fb7b3e75738b7f2b3f86698fa5bc1f26d811c5fd54c7f359b0fe675ddd521fde85185e3c577bd0c0fae94b57955ae6a5399b5e1bc4

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

@@ -10,11 +10,10 @@
 (def map (f things)
   ; transforms the list 'things by applying 'f to each item
   ; returns the resulting list
-  (if (no things)
-      nil
-      (pair? things)
+  (if (pair? things)
       (cons (f (car things)) (map f (cdr things)))
-      (map f (list things))))
+      things
+      (f things)))
 
 (def hash-cons (h k v)
   ; push 'v onto the value for 'k in 'h

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

@@ -1,4 +1,6 @@
-((fn (this-chapter-name chapters chapter-new chapter-build chapter-add-to-chapter)
+(def privately () nil)
+
+((fn (this-chapter-name chapters chapter-new chapter-build chapter-find-by-name chapter-add-to-chapter)
      (assign chapters (hash))
 
      (def chapter-end ()
@@ -20,15 +22,13 @@
              (cond name
                    (hash-set chapters
                              name
-                             (chapter-new (hash)
-                                          name)))))
+                             (chapter-new (hash) name)))))
+
+     (def chapter-find-by-name (name)
+       (chapter-build name (hash-get chapters name)))
 
      (def chapter-find (name)
-       (chapter-build (cond name
-                            name
-                            this-chapter-name)
-                      (hash-get chapters
-                                name)))
+       (chapter-find-by-name (cond name name this-chapter-name)))
 
      (def chapter-add-to-chapter (chapter attribute thing)
        (cond chapter
@@ -46,7 +46,7 @@
                                      description)))))
 
 (assign this-script nil)
-(assign this-plugin nil)
+(assign this-plugin "Nydp Core")
 
 ((fn (dox examples chapters dox-new dox-build)
      (def dox-build (hsh name what texts args src chapters)
@@ -65,7 +65,8 @@
        (dox-add-to-chapters item (hash-get item 'chapters)))
 
      (def dox-add-doc (name what texts args src chapters)
-       (dox-new (dox-build (hash) name what texts args src chapters)))
+       (cond (no (privately))
+             (dox-new (dox-build (hash) name what texts args src chapters))))
 
      (def dox-add-to-chapters (item chapters)
        (chapter-add-item item)

data/lib/lisp/core-017-builtin-dox.nydp

@@ -11,7 +11,7 @@
 (dox-add-doc 'eval      'def '("evaluate the given lisp expression")                                                                                             '(expr)               nil '(nydp-core))
 (dox-add-doc 'hash      'def '("create a new Hash instance")                                                                                                     nil                   nil '(hash-manipulation))
 (dox-add-doc 'apply     'def '("invoke f with args 'args")                                                                                                       '(f . args)           nil '(nydp-core))
-(dox-add-doc 'date      'def '("create a new date instance")                                                                                                     '(year month day)     nil '(time-date))
+(dox-add-doc 'date      'def '("create a new date instance")                                                                                                     '(year month day)     nil '(date-time))
 (dox-add-doc 'error     'def '("raise an exception")                                                                                                             'args                 nil '(flow-control))
 (dox-add-doc 'parse     'def '("parse the given string and return the corresponding lisp objects")                                                               '(str)                nil '(nydp-core))
 (dox-add-doc 'p         'def '("print a message on $stdout")                                                                                                     'args                 nil '(nydp-core))

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

@@ -24,12 +24,32 @@
                        (push x acc)))
           acc))
 
+(def list-slices (things slice-size)
+     ; slice 'things into a list of lists each with maximum 'slice-size items
+     (chapter pagination)
+     (chapter list-manipulation)
+     (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 string-strip (txt)
-  (string-replace "\\s+$"
-                  ""
-                  (string-replace "^\\s+"
-                                  ""
-                                  txt)))
+  (string-replace "(^\\s+|\\s+$)" "" txt))
 
 (def joinstr (txt . things)
   ; flatten 'things into a single list (ie unnest lists)
@@ -45,7 +65,8 @@
 
 (def j items
   ; delegate to 'joinstr with an empty join string
-  (joinstr ""  items))
+  ; shortcut for (joinstr ""  items)
+  (joinstr "" items))
 
 (def string-pieces pieces
   ; string-interpolation syntax emits this form. Default implementation
@@ -143,7 +164,7 @@
           (,rfname ,test)))))
 
 (mac loop (start test update . body)
-  ; execute 'start. then for as long as 'test returns non-nil,
+  ; execute 'start, then for as long as 'test returns non-nil,
   ; execute 'body and 'update
   (w/uniq (gfn gparm)
     `(do ,start
@@ -153,15 +174,21 @@
           ,test))))
 
 (mac for (v init max . body)
+  ; assign 'init to 'v, then execute 'body 'max times,
+  ; incrementing 'v at each iteration
   (w/uniq (gi gm)
     `(with (,v nil ,gi ,init ,gm (+ ,max 1))
        (loop (assign ,v ,gi) (< ,v ,gm) (assign ,v (+ ,v 1))
          ,@body))))
 
 (mac mapx (things x expr)
+  ; a macro wrapper for 'map
+  ; 'things is a list, 'x is the name of a variable, and 'expr
+  ; is evaluated and collected for each 'x in 'things
   `(map (fn (,x) ,expr) ,things))
 
 (def atom? (thing)
+  ; 't if 'thing is not a list or a hash
   (and thing
        (!pair? thing)
        (!hash? thing)))

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

@@ -2,11 +2,11 @@
 (assign all-tests nil)
 
 (def register-test (test)
-  "register a test to be run later by 'run-all-tests"
+  ; register a test to be run later by 'run-all-tests
   (push test all-tests))
 
 (def run-all-tests (verbose)
-  "runs all tests that have been registered with 'register-test"
+  ; runs all tests that have been registered with 'register-test
   (with (passed 0 failed 0)
     (with (f-pass (fn nil (assign passed (+ 1 passed)))
            f-fail (fn nil (assign failed (+ 1 failed))))

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

@@ -1,3 +1,4 @@
+
 (def bm-pythag ()
   (for i 1 50
     (for j 1 50
@@ -20,6 +21,27 @@
           (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))
@@ -27,6 +49,23 @@
 (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 ()
@@ -57,13 +96,28 @@
 
 (def rbs (name)
   (let summary nil
-    ;; (push (bm "pythag     "   bm-pythag            5     10) summary)
-    ;; (push (bm "recursive  "   bm-complicated       5   1000) summary)
-    ;; (push (bm "0 arg times"   bm-0-arg-times-call  5   1000) summary)
-    ;; (push (bm "1 arg times"   bm-1-arg-times-call  5   1000) summary)
-    ;; (push (bm "2 arg times"   bm-2-arg-times-call  5   1000) summary)
-    ;; (push (bm "3 arg times"   bm-3-arg-times-call  5   1000) summary)
-    ;; (push (bm "4 arg times"   bm-4-arg-times-call  5   1000) 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 "hashing"       bm-hash-fill 10  200000) summary)
     (each s summary (p name " " s))))

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

@@ -1,21 +1,25 @@
 (assign pp/special-forms (hash))
-(assign pp/line-break (uniq 'line-break))
+(assign pp/syntaxes      (hash))
+(assign pp/newline       (uniq 'newline))
+(assign pp/newline/noi   (uniq 'newline/noi))
 
-(def pp/escape-char (char)
+(def pp/esc-ch (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/esc-str-literal (txt)
+  (joinstr "" (map pp/esc-ch (string-split txt))))
 
-(def pp/string-piece (thing)
-  (if (isa 'string thing) (pp/escape-string-literal thing)
-      "\~~(pp thing)"))
+(def pp/string-piece (pp)
+  (fn (thing)
+      (if (isa 'string thing)
+          (pp/esc-str-literal thing)
+          "\~~(pp thing)")))
 
-(def pp/string-pieces (things) "\"~(joinstr "" (map pp/string-piece things))\"")
+(def pp/string-pieces (pp things) "\"~(joinstr "" (map (pp/string-piece pp) things))\"")
 
 (def pp/kv (hsh)
   (map λk(joinstr " "
@@ -23,13 +27,12 @@
                   (pp hsh.,k))
        (hash-keys hsh)))
 
-(def pp/literal (thing)
-  (if (eq? thing '||)
-      ""
-      (isa 'string thing)
-      "\"~(pp/escape-string-literal thing)\""
-      (isa 'hash thing)
-      "{ ~(joinstr " " (pp/kv thing)) }"
+(def pp/literal (thing indent)
+  (if (eq? thing '||)            "||"
+      (eq? thing pp/newline)     "\n~(joinstr " " indent)"
+      (eq? thing pp/newline/noi) "\n~(joinstr " " (cdr indent)) "
+      (isa 'string thing)        "\"~(pp/esc-str-literal thing)\""
+      (isa 'hash thing)          "{ ~(joinstr " " (pp/kv thing)) }"
       (inspect thing)))
 
 (mac pp/def (name args . body)
@@ -37,8 +40,7 @@
   ; 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
+  `(do (hash-set pp/special-forms ',name
                  (fn ,args ,@body))
        (dox-add-doc ',name
                     'pp/def
@@ -46,69 +48,120 @@
                     ',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/def brace-list       (form indent) "{~(pp/inline (cdr form) indent)}")
-
-(pp/syntax
- percent-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))" ""))
+(pp/def string-pieces    (pp form indent) (pp/string-pieces pp (cdr form)))
+(pp/def quasiquote       (pp form indent) "`~(pp (cadr form) (cons "" indent))" )
+(pp/def quote            (pp form indent) "'~(pp (cadr form) (cons "" indent))" )
+(pp/def unquote          (pp form indent) ",~(pp (cadr form) (cons "" indent))" )
+(pp/def unquote-splicing (pp form indent) ",@~(pp (cadr form) (cons " " indent))")
+(pp/def comment          (pp form indent) "; ~(cadr form)\n")
+(pp/def prefix-list      (pp form indent) "~(cadr form)~(pp (caddr form))")
+(pp/def brace-list       (pp form indent) "{ ~(joinstr " " (map λe(pprint e (cons "  " indent)) (cdr form))) }")
+
+(def pp/unsyntax (form)
+  (if (pair? form)
+      (let syntax (hash-get pp/syntaxes (car form))
+        (if syntax
+            (sym:joinstr syntax (map pp/unsyntax (cdr form)))
+            (map pp/unsyntax form)))
+      form))
+
+(hash-set pp/syntaxes 'percent-syntax "%")
+(hash-set pp/syntaxes 'colon-syntax ":")
+(hash-set pp/syntaxes 'dot-syntax   ".")
+(hash-set pp/syntaxes 'bang-syntax  "!")
+(hash-set pp/syntaxes 'ampersand-syntax "&")
+(hash-set pp/syntaxes 'dollar-syntax "$")
+(hash-set pp/syntaxes 'colon-colon-syntax "::")
+(hash-set pp/syntaxes 'arrow-syntax "->")
+(hash-set pp/syntaxes 'rocket-syntax "=>" )
 
 (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 (list-length:dox-args: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))
+  (if (pair? form)
+      (cons (pp/dotify:car form)
+            (if (pair? (cdr form))
+                (pp/dotify (cdr form))
+                (no:cdr form)
+                nil
+                (list '. (cdr form))))
+      form))
+
+(def pp/split-form (form n)
+  (cons (firstn n form)
+        (map list (nthcdr n form))))
+
+(def pp/flatly (form)
+  (if (pair? form)
+      (let special (hash-get pp/special-forms (car form))
+        (if special
+            (special pp/flatly form nil)
+            "(~(joinstr " " (map pp/flatly form)))"))
+      (pp/literal form nil)))
+
+(def pp/breaks? (form)
+  (and (pair? form)
+       (> (len:pp/flatly form) 40)))
+
+(def pp/breaker (form)
+  (if (pair? form)
+      (let key (car form)
+        (if (or (eq? 'if key)
+                (eq? 'cond key))
+            (pp/split-form form 2)
+            (and (hash-get macs key)
+                 (!proper? (dox-args key)))
+            (pp/split-form form (list-length:dox-args key))
+            (pp/split-form form 2)))
+      form))
+
+(def pp/break-pair (form)
+  (if (pair? form)
+      (if (hash-get pp/special-forms (car form))
+          form
+          (pp/breaks? form)
+          (intersperse-splicing pp/newline
+                                (pp/breaker (map pp/break-pair form)))
+          form)
+      form))
+
+(def pp/cleanup (str)
+  (string-replace "\\s+\\n" "\n" (string-replace "\\s+\\Z" "" str)))
+
+(def pp/indent (sym indent)
+  (if (or (no sym) (pair? sym))
+      indent
+      (cons (string-replace "." " " " ~sym") indent)))
+
+(def pprint (form indent)
+  (if (pair? form)
+      (let special-form (hash-get pp/special-forms (car form))
+        (if special-form
+            (special-form pp/printer form indent)
+            (let new-indent (pp/indent (car form) indent)
+              (let contents (joinstr " " (map λe(pprint e new-indent) form))
+                "(~contents)"))))
+      (pp/literal form indent)))
+
+(def pp/with-args (wargs)
+  (if (> (len (pp/flatly wargs)) 40)
+      (intersperse-splicing pp/newline/noi
+                            (pairs wargs))
+      wargs))
+
+(pp/def with (pp form indent)
+        (let wargs (pp/with-args (cadr form))
+          (let broken (intersperse pp/newline
+                                   (map pp/break-pair
+                                        (cddr form)))
+            (let wbody `(,wargs ,pp/newline ,@broken)
+              "(with ~(joinstr " " (map λe(pprint e (cons "     " indent)) wbody)))"))))
+
+(def pp/printer (form indent)
+  (if (pair? form)
+      (pprint (pp/break-pair form) indent)
+      (pp/literal form indent)))
+
+(def pp (form) (pp/cleanup:pp/printer (pp/dotify:pp/unsyntax form) nil))
+;; (def pp (form) (inspect form))
 
 (def dox-show-src (src)
   ; use the pretty-printer to elegantly display the given source code