nydp 0.3.0 → 0.4.0

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: 8ca4e399a839f5396035c2e8fe863c35e6c5acc4
-  data.tar.gz: 0e1ae8034c02c3d2401b97082d949bb29345ea5b
+  metadata.gz: 8d9a87eb0c014a51f391ddd1ba6686165a01ab48
+  data.tar.gz: 8c3f3146c0ae8dc18ac6e86324274423d75be651
 SHA512:
-  metadata.gz: 9bf68cd0b9627cf49ea2ddeb0f8ef53344b04576ecd5204dd04b943683b9b2610ba422c83d1ece2a9dc7b89968e2bfa251accad3e2bb9a450539160d660979c2
-  data.tar.gz: 2b40296df57b45e4d9e8be8f73aeecf38c2af80ac67d6da64407d57e69850c99820f582f14be8aa7f459ddc84e21cac6fbfa85759bed549b18474a6699f1524a
+  metadata.gz: f946a10304dd7422fb73243b9cd3ef40fab33aa9ff4f0b53568278761b64905d00714ed0cf7401db29b8c3613d8a683460ed48feef3f174ab0c724dd3e5f922e
+  data.tar.gz: 1925438dd0eca5a718e6f41ff39ef9f35e1a9ed18279e58f2ebfa88c284cb46526f4864932db706dc346662a59cb153fbec70fca1047aeddc742740de971dab5

data/.zeiger.yml

@@ -0,0 +1,28 @@
+search:
+  - "bin/**/*"
+  - "lib/**/*"
+  - "spec/**/*"
+  - "*.gemspec"
+  - ".*.yml"
+  - ".git?*"
+  - "Gemfile*"
+  - README
+ignore:
+  - .doc$
+  - .ods$
+  - .gz$
+  - .png$
+  - .gif$
+  - .zip$
+  - .jpg$
+  - .xcf$
+  - .pdf$
+  - /select2/.*.js$
+stats:
+  nydp:
+    - ".*\\.nydp"
+  code:
+    - "lib/.*\\.(rb|rake)"
+  test:
+    - "spec/.*"
+    - "test/.*"

data/lib/lisp/core-000.nydp

@@ -5,8 +5,8 @@
 ;; to, 'do, 'rfn, 'loop, 'for) were directly inspired by (aka stolen from) arc.arc. See
 ;; README.md however for some significant differences
 
+(assign   noop (fn))
 (assign   list (fn args args))
-(assign   noop (fn args nil))
 (assign     x1 (fn (arg) arg))
 (assign   caar (fn (arg) (car (car arg))))
 (assign   cadr (fn (arg) (car (cdr arg))))

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

@@ -14,9 +14,6 @@
        (hash-set hsh 'name name)
        hsh)
 
-     (def chapter-names () (hash-keys chapters))
-     (def chapter-current () this-chapter-name)
-
      (def chapter-build (name chapter)
        (cond chapter
              chapter
@@ -25,8 +22,10 @@
                              name
                              (chapter-new (hash) name)))))
 
-     (def chapter-find (name)
-       (chapter-build name (hash-get chapters name)))
+     (def chapter-names   ()     (hash-keys chapters))
+     (def chapter-current ()     this-chapter-name)
+     (def chapter-delete  (name) (hash-set chapters name nil))
+     (def chapter-find    (name) (chapter-build name (hash-get chapters name)))
 
      (def chapter-add-to-chapter (chapter attribute thing)
        (cond chapter
@@ -62,9 +61,9 @@
        (hash-cons dox (hash-get item 'name) item)
        (dox-add-to-chapters item (hash-get item 'chapters)))
 
-     (def dox-add-doc (name what texts args src chapters)
+     (def dox-add-doc (name what texts args src chapters more)
        (cond (no (privately))
-             (dox-new (dox-build (hash) name what texts args src chapters))))
+             (dox-new (dox-build (if more more (hash)) name what texts args src chapters))))
 
      (def dox-add-to-chapters (item chapters)
        (cond chapters
@@ -85,8 +84,6 @@
        (cond (dox? name)
              (hash-get (car (dox-lookup name)) attr)))
 
-     (def dox-chapter-names () (hash-keys chapters      ))
-     (def dox-chapter   (name) (hash-get chapters name  ))
      (def dox-what-is?  (name) (dox-get-attr name 'what ))
      (def dox-src       (name) (dox-get-attr name 'src  ))
      (def dox-examples  (name) (hash-get examples name  ))

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

@@ -7,6 +7,10 @@
 (dox-add-doc '/         'def '("return the result of dividing all other args into the first arg." "(/ a b c d) is equivalent to (/ a (* b c d))")                'things               nil '(math))
 (dox-add-doc '>         'def '("true if each arg is greater than the next arg")                                                                                  'things               nil '(math))
 (dox-add-doc '<         'def '("true if each arg is less than the next arg")                                                                                     'things               nil '(math))
+(dox-add-doc '**        'def '("returns a to the power of b")                                                                                                    '(a b)                nil '(math))
+(dox-add-doc '⌊         'def '("returns the floor of a (round towards -∞)")                                                                                      '(a)                  nil '(math))
+(dox-add-doc '⌈         'def '("returns the ceiling of a (round towards +∞)")                                                                                    '(a)                  nil '(math))
+(dox-add-doc 'round     'def '("returns a rounded half-away from zero")                                                                                          '(a)                  nil '(math))
 (dox-add-doc 'mod       'def '("return the remainder after diving a by b")                                                                                       '(a b)                nil '(math))
 (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))
@@ -18,6 +22,19 @@
 (dox-add-doc 'sort      'def '("return 'things, sorted according to their natural sort order")                                                                   'things               nil '(list-manipulation))
 (dox-add-doc 'sqrt      'def '("return the square root of 'arg")                                                                                                 '(arg)                nil '(math))
 (dox-add-doc 'sym       'def '("return the symbol for the given string 'arg")                                                                                    '(arg)                nil '(nydp-core))
+(dox-add-doc 'list      'def '("returns args as a list")                                                                                                         'args                 nil '(nydp-core))
+(dox-add-doc 'noop      'def '("does nothing; returns nil")                                                                                                      nil                   nil '(nydp-core))
+(dox-add-doc 'x1        'def '("just returns arg; the identity function")                                                                                        '(arg)                nil '(nydp-core))
+(dox-add-doc 'caar      'def '("car of car; same as (car (car arg))")                                                                                            '(arg)                nil '(nydp-core))
+(dox-add-doc 'cadr      'def '("car of cdr; same as (car (cdr arg))")                                                                                            '(arg)                nil '(nydp-core))
+(dox-add-doc 'cdar      'def '("cdr of car; same as (cdr (car arg))")                                                                                            '(arg)                nil '(nydp-core))
+(dox-add-doc 'cddr      'def '("cdr of cdr; same as (cdr (cdr arg))")                                                                                            '(arg)                nil '(nydp-core))
+(dox-add-doc 'no        'def '("t if arg is nil, nil otherwise")                                                                                                 '(arg)                nil '(nydp-core))
+(dox-add-doc 'just      'def '("just returns arg; the identity function")                                                                                        '(arg)                nil '(nydp-core))
+(dox-add-doc 'isa       'def '("t if (type-of obj) is equal to type")                                                                                            '(type obj)           nil '(nydp-core))
+(dox-add-doc 'pair?     'def '("t if arg is a cons cell or (equivalently) the start of a list")                                                                  '(arg)                nil '(nydp-core))
+(dox-add-doc 'hash?     'def '("t if arg is a hash")                                                                                                             '(arg)                nil '(nydp-core))
+(dox-add-doc 'sym?      'def '("t if arg is a symbol, nil otherwise")                                                                                            '(arg)                nil '(nydp-core))
 (dox-add-doc 'ensuring  'def '("execute 'tricky-f, then 'ensure-f afterwards"
                                "'ensure-f will always be executed, even if there is an error in 'tricky-f"
                                "returns the return value of 'tricky-f")                                                                                          '(ensure-f tricky-f)  nil '(flow-control))
@@ -29,6 +46,7 @@
 (dox-add-doc 'string-length   'def '("return the length of 'arg")                                                                                                '(arg)                nil '(string-manipulation))
 (dox-add-doc 'string-replace  'def '("replace 'pattern with 'insert in 'str")                                                                                    '(pattern insert str) nil '(string-manipulation))
 (dox-add-doc 'string-split    'def '("split 'str delimited by 'delim")                                                                                           '(str delim)          nil '(string-manipulation))
+(dox-add-doc 'string-match    'def '("if 'str matches 'pattern, return hash with keys 'match and 'captures ; otherwise nil")                                     '(str pattern)        nil '(string-manipulation))
 (dox-add-doc 'time            'def '("with no args, return the current time."
                                      "With one arg, if 'arg-0 is a number, return the current time plus 'arg-0 seconds."
                                      "With one arg, if 'arg-0 is a date, return the time at the beginning of the given date."
@@ -53,3 +71,18 @@
 (dox-add-doc 'script-run      'def '("announces the start of a plugin load or a script load."
                                      "'event may be one of '(script-start script-end plugin-start plugin-end)"
                                      "'name is the name of the script or plugin concerned")                                                                      '(event name)         nil '(nydp-core))
+
+(dox-add-doc 'chapter-end     'def '("Announce the end of a chapter. Called by 'plugin-start, 'plugin-end, 'script-start, 'script-end")                          nil                   nil '(nydp/documentation))
+(dox-add-doc 'chapter-start   'def '("Announce the start of a chapter. Creates a new chapter if the named chapter does not already exist")                 '(chapter-name description) nil '(nydp/documentation))
+(dox-add-doc 'chapter-names   'def '("Get the names of all the chapters nydp knows about")                                                                       nil                   nil '(nydp/documentation))
+(dox-add-doc 'chapter-current 'def '("Get the name of the chapter in progress right now - this is normally the last value sent to 'chapter-start")               nil                   nil '(nydp/documentation))
+(dox-add-doc 'chapter-delete  'def '("Remove the named chapter")                                                                                                 '(name)               nil '(nydp/documentation))
+(dox-add-doc 'chapter-find    'def '("Get the named chapter")                                                                                                    '(name)               nil '(nydp/documentation))
+(dox-add-doc 'dox-add-doc     'def '("Store the provided documentation item."
+                                     "'name is the name of the item"
+                                     "'what is the type of the item ('def or 'mac or 'thingy ... this is user-definable, not related to 'type-of)"
+                                     "'texts is a list of strings to store for this item"
+                                     "'args is the args if the item has the notion of args"
+                                     "'src the source code of the item if any"
+                                     "'chapters the chapters to which the item should be added, if any")                                          '(name what texts args src chapters) nil '(nydp/documentation))
+(dox-add-doc 'dox-add-examples 'def '("Add the given examples to the dox for the named item")                                                                    '(name example-exprs) nil '(nydp/documentation))

data/lib/lisp/core-025-warnings.nydp

@@ -0,0 +1,15 @@
+(chapter-start 'nydp/warnings "Store, display, and manage warnings")
+
+(def warnings/clear nil
+  ; clear all stored warnings
+  (assign warnings/list nil))
+
+(warnings/clear)
+
+(def warnings (f)
+  ; apply f to each stored warning. For example, (warnings p) to print warnings to console
+  (mapply f warnings))
+
+(def warnings/new (kind . info)
+  ; store a warning for future retrieval or display
+  (assign warnings/list (cons (cons kind info) warnings/list)))

data/lib/lisp/core-030-syntax.nydp

@@ -190,15 +190,41 @@ scoping, assignment, anonymous functions and more...")
 (def hash-get-assignment (lookup value)
   `(hash-set ,@lookup ,value))
 
+(def ampersand-expression? (name)
+  (and (pair? name)
+       (caris 'ampersand-syntax (car name))))
+
+(def ampersand-expression-assignment (place value)
+  ; (= (&key (expr)) (val))
+  ; (= ((ampersand-syntax key) (expr)) (val))
+  ; 'place is ((ampersand-syntax || key) (expr))
+  ; we need (hash-set (expr) 'key (val))
+  ; however,
+  ; (= (&key.subkey (expr)) (val))
+  ; 'place is ((ampersand-syntax || (dot-syntax key subkey)) (expr))
+  ; we need (hash-set (hash-get (expr) 'key) 'subkey (val))
+  (with (k   (cadr:cdar place)
+         hsh (cadr place))
+    (if (caris 'dot-syntax k)
+        (dot-syntax-assignment (cons hsh (cdr k)) value)
+        `(hash-set ,hsh ',k ,value))))
+
 (mac = (name value)
   ; generic assignment which unlike builtin 'assign, knows how to assign
   ; to hash keys
+  ; (= (hash-get (expr) 'key) (val) => (hash-set (expr) 'key (val))
+  ; (= h.k (val))                   => (hash-set h 'k (val))
+  ; (= h.j.k (val))                 => (hash-set (hash-get h 'j) 'k (val))
+  ; (= (&key (expr)) (val))         => (hash-set (expr) 'key (val))
+  ; (= (&j.k (expr)) (val))         => (hash-set (hash-get (expr) 'j) 'k (val))
   (if (isa 'symbol name)
       `(assign ,name ,value)
       (caris 'dot-syntax name)
       (dot-syntax-assignment (cdr name) value)
       (caris 'hash-get name)
-      (hash-get-assignment (cdr name) value)))
+      (hash-get-assignment (cdr name) value)
+      (ampersand-expression? name)
+      (ampersand-expression-assignment name value)))
 
 (mac def-assign args
   ; override previous definition to allow expressions like (def hsh.foo (arg arg2) ...)
@@ -276,7 +302,7 @@ scoping, assignment, anonymous functions and more...")
   (if (pair? args)
       `(,(car args) (nth ,n ,var) ,@(destructure/with var (cdr args) (+ n 1)))
       args
-      `(,args (lastcdr ,var))))
+      `(,args (nthcdr ,n ,var))))
 
 (def destructure/build (given-args new-args body)
   ; used internally by 'fun
@@ -291,7 +317,17 @@ scoping, assignment, anonymous functions and more...")
                                      `((with ,(destructure/with destructure (car given-args) 0) ,@body)))))
       `(fn ,(rev new-args given-args) ,@body)))
 
+
+(def fun/approve-arg-names (orig args)
+  (if (pair? args)
+      (do (fun/approve-arg-names orig (car args))
+          (fun/approve-arg-names orig (cdr args)))
+      args
+      (if (hash-get macs args)
+          (warnings/new 'arg-shadows-macro "arg " args " shadows macro " args " in arg list " orig))))
+
 (mac fun (args . body)
   ; build a 'fn form, changing 'args and 'body to
   ; properly handle any destructuring args if present
+  (fun/approve-arg-names args args)
   (destructure/build args nil body))

data/lib/lisp/core-035-flow-control.nydp

@@ -63,6 +63,6 @@
     (w/uniq h
             `(let ,h (hash)
                (def ,name ,args
-                 ,@(if forms.comment (map (fn (c) list 'comment c)) forms.comment)
-                 ,(if forms.chapter `(chapter ,forms.chapter))
+                 ,@(map (fn (c) (cons 'comment c)) forms.comment)
+                 ,@(map (fn (c) (cons 'chapter c)) forms.chapter)
                  (cache-get ,h (list ,@args) (do ,@(hash-get forms nil))))))))

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

@@ -1,10 +1,10 @@
 (chapter-start 'list-manipulation "utilities for manipulating and iterating over lists, including filters and transforms")
 
-(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 zip args
+  ; takes a list of lists, ((p q r) (1 2 3) (a b c) ...), returns ((p 1 a ...) (q 2 b ...) (r 3 c ...))
+  (if (car args)
+      (cons (map car args)
+            (apply zip (map cdr args)))))
 
 (def eachr (f things)
      (when things
@@ -12,9 +12,11 @@
        (f (car things))))
 
 (mac push (x things)
+  ; assign (cons x things) to things
   `(= ,things (cons ,x ,things)))
 
 (def flatten (things)
+  ; flatten the given list, recursively
      (let acc nil
           (rfnwith flattenize (x things)
                    (if (pair? x)

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

@@ -4,13 +4,24 @@
      (or (eq? x y)
          (and (pair? x)
               (pair? y)
+              (eq? (len x) (len y))
               (iso (car x) (car y))
               (iso (cdr x) (cdr y)))))
 
-(def num?    (arg)   (isa 'number arg))
-(def string? (arg)   (isa 'string arg))
-(mac just    (arg)   arg)
-(def quotify (arg)   `(quote ,arg))
+(def num?    (arg) (comment "true if arg is a number") (isa 'number arg))
+(def string? (arg) (comment "true if arg is a string") (isa 'string arg))
+
+(mac just (expr)
+  ; this is useful sometimes when 'expr can't stand on its own due to lexical ambiguity, most often in string interpolations
+  ; for example, in "hello ~person, how are you", the parser will try to interpolate the symbol "person," rather than the
+  ; expected "person". In this case, use "hello ~(just person), how are you"
+  expr)
+
+(def quotify (arg) `(quote ,arg))
+
+(defmemo k (arg)
+  ; return a function that always returns 'arg, similar to K in SKI calculus
+  (fn nil arg))
 
 (def len (things)
   ; return the length of 'things where 'things may be nil, a string, list or hash

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

@@ -34,6 +34,7 @@
   ; 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
+  ; note that this preserves improper lists and may return only the lastcdr if all else fails...
   (rfnwith collector (items things)
            (if (no items)
                nil

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

@@ -84,3 +84,9 @@ Examples for ~name
                         (apply macfn
                                (cdr expr)))
             expr))))
+
+(def chapter-remove-item (chapter-name item-name)
+  ; remove the named item from the named chapter
+  (chapter nydp/documentation)
+  (let ch (chapter-find chapter-name)
+    (= ch.contents (collect (fn (item) (!eq? item.name item-name)) ch.contents))))

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

@@ -26,15 +26,15 @@
 
 (def execute-single-test (desc test passf failf verbose)
   (if verbose (p desc " - " (car test)))
-  (with (expected (nth 2 test) result (eval (nth 1 test)))
-        (if (iso result expected)
-            (passf)
-            (do (p desc " - " (car test) " - FAILED:
-   running  " (pp (nth 1 test)) ",
-   expected " (inspect expected) ",
-   got      " (inspect result) "
-")
-                (failf)))))
+  (on-err (error (j "FAILED " desc " - " (car test)) (pp:nth 1 test))
+          (with (expected (nth 2 test) result (eval (nth 1 test)))
+                (if (iso result expected)
+                    (passf)
+                    (do (p desc " - " (car test) " - FAILED:
+                           running  " (pp (nth 1 test)) ",
+                           expected " (inspect expected) ",
+                           got      " (inspect result) "\n")
+                        (failf))))))
 
 (def execute-tests (desc tests passf failf verbose)
   (execute-test desc

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

@@ -26,8 +26,8 @@
   `(push (cons ,regex (fn (,prefix-var ,list-var) ,@body))
          prefix-list-prefixes))
 
-(define-prefix-list-macro "^λ.+" vars expr
+(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))
+  (let var-list (map sym (collect !empty? (cdr:string-split vars)))
     `(fn ,var-list ,expr)))

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

@@ -1,21 +1,45 @@
+(chapter-start 'nydp/hooks "event management - execute a piece of code when something happens")
+
 (let hooks {}
   (def hook-names ()
+    ; return the list of hook-names
     (hash-keys hooks))
 
   (def hooks-for (hook-name)
+    ; return the list of hooks for 'hook-name
     hooks.,hook-name)
 
   (def add-hook (hook-name f)
+    ; add a function 'f to execute when 'hook-name is fired
     (hash-cons hooks hook-name f))
 
   (def clear-hooks (hook-name)
+    ; remove all hooks for 'hook-name
     (= hooks.,hook-name nil))
 
+  (def without-hooks (hook-name f)
+    ; temporarily remove all hooks for 'hook-name, restoring them after running 'f
+    (let previous-hooks (hooks-for hook-name)
+      (ensure (= hooks.,hook-name previous-hooks)
+              (clear-hooks hook-name)
+              (f))))
+
   (def remove-hook (hook-name f)
+    ; only works if you have a reference to the original function
     (= hooks.,hook-name
        (collect (curry !eq? f)
                hooks.,hook-name)))
 
   (def run-hooks (hook-name . args)
+    ; apply all functions attached to 'hook-name to given 'args
     (each hook (hooks-for hook-name)
           (apply hook args))))
+
+(add-hook 'warnings/new λw(apply p w))
+
+(let super warnings/new
+  (def warnings/new (kind . info)
+    ; enhance original warnings/new to run the 'warnings/new hook
+    (chapter nydp/warnings)
+    (apply super kind info)
+    (run-hooks 'warnings/new (cons kind info))))

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

@@ -87,7 +87,7 @@
            (nth (= i (mod (+ 1 (or j i)) list-len))
                 xs))))
 
-(def fill-bucket (items bucket size-f bucket-size maximum-size)
+(def bucket/fill (items bucket size-f bucket-size maximum-size)
   ; returns a list (list a b c) where
   ; 'a is a subset of 'items
   ; 'b is the sum of sizes of items in 'a : (apply + (map size-f a))
@@ -101,12 +101,40 @@
   ; 'size-f is a function that can tell the size of each item in 'items
   ; 'bucket-size is the size of the existing bucket, or 0 if empty
   ; 'maximum-size is the maximum allowed size for the bucket
-  (let next-item (car items)
-    (let next-size (+ (size-f next-item) bucket-size)
-      (if (< next-size maximum-size)
-          (fill-bucket (cdr items)
-                       (cons next-item bucket)
-                       size-f
-                       next-size
-                       maximum-size)
-          (list (rev bucket) bucket-size items)))))
+  ; implementation note: this function exploits the behaviour of '> returning its last argument when true
+  (aif (and items
+            (> maximum-size (+ (size-f (car items)) bucket-size)))
+       (bucket/fill (cdr items)
+                    (cons (car items) bucket)
+                    size-f
+                    it
+                    maximum-size)
+       (and items (eq? bucket-size 0))
+       (bucket/fill (cdr items)
+                    (cons (car items) bucket)
+                    size-f
+                    (size-f (car items))
+                    maximum-size)
+       (list (rev bucket) bucket-size items)))
+
+(def bucket/new (buckets)
+  ; used by 'fill-buckets
+  (cons { bucket-size 0 } buckets))
+
+(def fill-buckets (items max buckets size-f key)
+  ; useful for pagination where each item may have a different size
+  ; returns a list of hash with keys 'bucket-size and key
+  ; if buckets is non-nil, assumes it is a list of previously-established buckets
+  ; will add new items to first bucket if its 'bucket-size permits
+  (if items
+      (if buckets
+          (let initial (car buckets)
+            (let (these size others)
+                 (bucket/fill items nil size-f initial.bucket-size max)
+              (hash-set initial key these)
+              (= initial.bucket-size size)
+              (if others
+                  (fill-buckets others max (bucket/new buckets) size-f key)
+                  (fill-buckets others max buckets size-f key))))
+          (fill-buckets items max (bucket/new buckets) size-f key))
+      buckets))