nydp 0.2.3 → 0.2.5

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: 546120f25e3fa424942cb1d4f6296da7007fa3a1
-  data.tar.gz: afc6a8ac316812422abd8b4d8aa0e7c870ab73fd
+  metadata.gz: dc628274c2cf2f44cd05559766575d3cc9920d69
+  data.tar.gz: 619d6083cf6dab728793950bbc005fe3b281be56
 SHA512:
-  metadata.gz: a8d144329085f686df6e0b3b12be6fb207e08fe0edca7633088d3a59095cdf1c0953636b8faf352037bdd22fc13dbc822604a76b6f6709b1e3d74787362ad34c
-  data.tar.gz: 6c0875dfd8712fc2fb22dd987cc4cf323d7e4c39b6444e4da0b6e8790706e3f7714f0e1fdac563edad9ce1104cb1e38600becb3fdcadd668b498d0c2b5c9384c
+  metadata.gz: 391b384008f3e7e23505cb0871ab667435aea31a0841f71f3572316bdf1fc731a142f6dff7f0e2be26cf2eb60750bd60cf8ae89f298f9670f387b24fa2fd6141
+  data.tar.gz: 4390de26c600a52fbcf82bd91045acd3ed8791aeddcbec340cd227982632a28cdf2cbb1db42f2608f48b04010d3526870d5bfbfcc8161bf6601edd290394b5e5

data/bin/nydp

@@ -2,4 +2,4 @@
 
 require 'nydp'
 
-Nydp.repl verbose: ($*.include? "-v")
+Nydp.repl verbose: ($*.include? "-v"), exit: ($*.include? "-x"), silent: ($*.include? "-s")

data/lib/lisp/core-000.nydp

@@ -6,6 +6,7 @@
 ;; README.md however for some significant differences
 
 (assign   list (fn args args))
+(assign   noop (fn args nil))
 (assign   caar (fn (arg) (car (car arg))))
 (assign   cadr (fn (arg) (car (cdr arg))))
 (assign   cdar (fn (arg) (cdr (car arg))))

data/lib/lisp/core-010-precompile.nydp

@@ -70,11 +70,11 @@
            (qq-skip-unquote-splicing arg rest level)))
 
 (def qq-do-unquote-splicing (arg rest level)
-     (cond (no rest)
-           arg
+     (cond rest
            (list '+
                  (pre-compile arg)
-                 (qq-quasiquote rest level))))
+                 (qq-quasiquote rest level))
+           arg))
 
 (def qq-skip-unquote-splicing (arg rest level)
      (list 'cons
@@ -117,18 +117,18 @@
            (pre-compile xs)
            (list 'list ''unquote (qq-quasiquote xs (- level 1)))))
 
-(def qq-quasiquote (xs level)
-            (cond (no xs)
-                  nil
-                  (cond (pair? xs)
-                        (cond (eq? (car xs) 'unquote)
-                              (qq-maybe-unquote (cadr xs) level)
-                              (cond (eq? (car xs) 'unquote-splicing)
-                                    (qq-handle-unquote-splicing (cadr xs) nil level)
-                                    (cond (eq? (car xs) 'quasiquote)
-                                          (list 'list ''quasiquote (qq-quasiquote (cdr xs) (+ level 1)))
-                                          (qq-unquote? (car xs) (cdr xs) level))))
-                        (list 'quote xs))))
+(def qq-quasiquote (things level)
+  (cond things
+        (cond (pair? things)
+              (cond (eq? (car things) 'unquote)
+                    (qq-maybe-unquote (cadr things) level)
+                    (cond (eq? (car things) 'unquote-splicing)
+                          (qq-handle-unquote-splicing (cadr things) nil level)
+                          (cond (eq? (car things) 'quasiquote)
+                                (list 'list ''quasiquote (qq-quasiquote (cdr things) (+ level 1)))
+                                (qq-unquote? (car things) (cdr things) level))))
+              (list 'quote things))
+        nil))
 
 (hash-set macs 'quasiquote
           (fn (arg) (qq-quasiquote arg 0)))

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

@@ -1,11 +1,12 @@
 
 (hash-set macs 'if (fn args
-                       (cond (no args) nil
+                       (cond args
                              (cond (cdr args)
                                    (cond (cddr args)
                                          `(cond ,(car args) ,(cadr args) (if ,@(cddr args)))
                                          `(cond ,(car args) ,(cadr args)))
-                                   (car args)))))
+                                   (car args))
+                             nil)))
 
 (def map (f things)
   ; transforms the list 'things by applying 'f to each item
@@ -20,10 +21,10 @@
   (hash-set h k (cons v (hash-get h k))))
 
 (def rev-accum (things acc)
-  (cond (no things)
-        acc
+  (cond things
         (rev-accum (cdr things)
                    (cons (car things)
-                         acc))))
+                         acc))
+        acc))
 
 (def rev (things) (rev-accum things nil))

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

@@ -9,12 +9,13 @@
                "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")
              'args
-             '(cond (no args) nil
+             '(cond args
                     (cond (cdr args)
                           (cond (cddr args)
                                 `(cond ,(car args) ,(cadr args) (if ,@(cddr args)))
                                 `(cond ,(car args) ,(cadr args)))
-                          (car args)))
+                          (car args))
+                    nil)
              '(flow-control))
 
 (dox-add-doc 'map
@@ -22,11 +23,10 @@
              '("transforms the list 'things by applying 'f to each item"
                "returns the resulting list")
              '(f things)
-             '(if (no things)
-                  nil
-                  (pair? things)
+             '(if (pair? things)
                   (cons (f (car things)) (map f (cdr things)))
-                  (map f (list things)))
+                  things
+                  (f things))
              '(list-manipulation))
 
 (dox-add-doc 'rev
@@ -42,3 +42,17 @@
              '(h k v)
              '(hash-set h k (cons v (hash-get h k)))
              '(hash-manipulation))
+
+(def join-str (prefix joint things)
+  (chapter string-manipulation)
+  ; equivalent to (join-str "~prefix~joint~(car things)" joint (cdr things)) - except
+  ; 'string-pieces hasn't been defined yet, and if it were, it would be defined in terms of
+  ; 'join-str, so it would be circular.
+  ; see 'joinstr for a more powerful and easier-to-use implementation of the same idea
+  (if things
+      (join-str (+ (to-string prefix)
+                   joint
+                   (to-string (car things)))
+                joint
+                (cdr things))
+      prefix))

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

@@ -47,7 +47,7 @@ scoping, assignment, anonymous functions and more...")
              (fn (,var) ,@body)))
 
 (def-colon-syntax || names
-  (error "Irregular ': syntax: got ~(inspect names) : not prefix-syntax : in ~(joinstr ":" names)"))
+  (error "Irregular ': syntax: got ~(inspect names) : not prefix-syntax : in ~(join-str (car names) ":" (cdr names))"))
 
 (mac colon-syntax names
   ; handle syntax of the form a:b, which the parser expands to
@@ -68,9 +68,9 @@ scoping, assignment, anonymous functions and more...")
   ; For example,
   ; (!eq? a 10) is the same as (no:eq? a 10), which is the same as (no (eq? a 10))
   (if (no (eq? pfx '||))
-      (error "Irregular '! syntax: got prefix ~(inspect pfx) in ~(joinstr "!" (cons pfx rest))"))
+      (error "Irregular '! syntax: got prefix ~(inspect pfx) in ~(join-str pfx "!" rest)"))
   (if (cdr rest)
-      (error "Irregular '! syntax: got suffix ~(inspect (cdr rest)) in ~(joinstr "!" (cons pfx rest))")
+      (error "Irregular '! syntax: got suffix ~(inspect (cdr rest)) in ~(join-str pfx "!" rest)")
       (if (caris 'colon-syntax (car rest))
           `(colon-syntax no ,@(cdar rest))
           `(colon-syntax no ,(car rest)))))
@@ -79,10 +79,10 @@ scoping, assignment, anonymous functions and more...")
   `(cond ,condition (do ,@body)))
 
 (def pairs (things)
-     (if (no things)       nil
-       (no (cdr things)) (list (list (car things)))
-       (cons (list (car things) (cadr things))
-             (pairs (cddr things)))))
+  (if (no things)       nil
+      (no (cdr things)) (list (list (car things)))
+      (cons (list (car things) (cadr things))
+            (pairs (cddr things)))))
 
 (mac with (parms . body)
      `((fn ,(map car (pairs parms))
@@ -117,13 +117,11 @@ scoping, assignment, anonymous functions and more...")
        (,name ,@(map cadr ppairs)))))
 
 (let uniq-counter 0
-     (def uniq (prefix)
-          (sym (joinstr "-"
-                        (list prefix
-                              (assign uniq-counter
-                                      (+ uniq-counter 1))))))
-     (def reset-uniq-counter ()
-          (assign uniq-counter 0)))
+  (def uniq (prefix)
+    (assign uniq-counter (+ uniq-counter 1))
+    (sym (join-str prefix "-" (list uniq-counter))))
+  (def reset-uniq-counter ()
+    (assign uniq-counter 0)))
 
 (mac w/uniq (vars . body)
   ; creates a lexical scope with a unique symbol assigned to
@@ -226,9 +224,9 @@ scoping, assignment, anonymous functions and more...")
 (mac ampersand-syntax (pfx . rest)
   ; parser expands a&b to (ampersand-syntax a b)
   (if (no (eq? pfx '||))
-      (error "Irregular '& syntax: got prefix ~(inspect pfx) in ~(joinstr "&" (cons pfx rest))"))
+      (error "Irregular '& syntax: got prefix ~(inspect pfx) in ~(join-str pfx "&" rest)"))
   (if (cdr rest)
-      (error "Irregular '& syntax: got suffix ~(inspect (cdr rest)) in ~(joinstr "&" (cons pfx rest))")
+      (error "Irregular '& syntax: got suffix ~(inspect (cdr rest)) in ~(join-str pfx "&" rest)")
       (build-ampersand-syntax (car rest))))
 
 (mac brace-list-mono (arg)

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

@@ -2,9 +2,10 @@
 
 (mac on-err (handler . body)
   ; executes 'body. If an error is raised, executes 'handler. Inside
-  ; 'handler, the parameter 'err refers to the error that was raised.
-  `(handle-error (fn (err) ,handler)
-                 (fn ()    ,@body)))
+  ; 'handler, the parameter 'errors is a list of error messages extracted from
+  ; the sequence of errors that led here (Exception#cause in ruby or Throwable.getCause() in java)
+  `(handle-error (fn (errors) ,handler)
+                 (fn ()       ,@body)))
 
 (mac ensure (protection . body)
   ; executes 'body. Afterwards, executes 'protection.
@@ -39,12 +40,29 @@
        (loop (assign ,v ,gi) (< ,v ,gm) (assign ,v (+ ,v 1))
          ,@body))))
 
-(def curry (func . args1)
+(mac curry (func . args1)
   ; return a new function which is the original function with
   ; the given args1 already applied
   ; arguments to the new function are whatever arguments remain
   ; for the old function
-  (fn args
-      (apply func
-             (joinlists args1
-                        args))))
+  `(fn args (apply ,func ,@args1 args)))
+
+(mac cache-get (hsh key val)
+  ; if ,key is already in ,hsh - return the associated value.
+  ; if ,key is not already in ,hsh - evaluate ,val, store the result
+  ; under ,key in ,hsh, and return it
+  (w/uniq (h k v)
+    `(with (,h ,hsh ,k ,key)
+           (let ,v (hash-get ,h ,k)
+             (or ,v (returnlet ,v ,val (hash-set ,h ,k ,v)))))))
+
+(mac defmemo (name args . body)
+  ; same as 'def, but caches the result, keyed on args, so for a given set of args the result
+  ; is only ever calculated once
+  (let forms (filter-forms (build-def-hash (hash)) body)
+    (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))
+                 (cache-get ,h (list ,@args) (do ,@(hash-get forms nil))))))))

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

@@ -1,17 +1,5 @@
 (chapter-start 'nydp-core "essential functions for getting anything done")
 
-(def joinstr (txt . things)
-  ; flatten 'things into a single list (ie unnest lists)
-  ; convert each item to a string
-  ; return a single string which is the concatenation of each
-  ; stringified item, with given 'txt inserted in between
-  ; each item
-  (let joinables (flatten things)
-    (apply +
-           (to-string (car joinables))
-           (flatten (zip (map (fn (_) txt) (cdr joinables))
-                         (map to-string (cdr joinables)))))))
-
 (def iso (x y)
      (or (eq? x y)
          (and (pair? x)
@@ -21,6 +9,7 @@
 
 (def x1      (thing) thing)
 (def sym?    (arg)   (isa 'symbol arg))
+(def num?    (arg)   (isa 'number arg))
 (def string? (arg)   (isa 'string arg))
 (mac just    (arg)   arg)
 (def quotify (arg)   `(quote ,arg))
@@ -32,11 +21,11 @@
   (chapter list-manipulation)
   (chapter string-manipulation)
   (chapter hash-manipulation)
-  (if (no things)      0
-      (pair? things)   (list-length things)
+  (if (pair? things)   (list-length things)
       (string? things) (string-length things)
       (hash? things)   (list-length:hash-keys things)
-      nil))
+      things           nil
+      0))
 
 (assign dynamics (hash))
 

data/lib/lisp/core-041-string-utils.nydp

@@ -11,9 +11,9 @@
   ; each item
   (let joinables (flatten things)
     (apply +
-           (to-string (car joinables))
-           (flatten (zip (map (fn (_) txt) (cdr joinables))
-                         (map to-string (cdr joinables)))))))
+           (to-string:car joinables)
+           (flatten (map (fn (x) (list txt x))
+                         (cdr joinables))))))
 
 (def j items
   ; delegate to 'joinstr with an empty join string

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

@@ -1,18 +1,20 @@
 (chapter-start 'list-manipulation)
 
 (def list-length (things)
-  (if (no things)    0
-      (atom? things) 1
-      (+ 1 (list-length:cdr things))))
+  (if (atom? things) 1
+      things         (+ 1 (list-length (cdr things)))
+      0))
 
 (def list-slices (things slice-size)
      ; slice 'things into a list of lists each with maximum 'slice-size items
      (chapter pagination)
-     (if (< (len things) slice-size)
-         (cons things nil)
-         (cons (firstn slice-size things)
-               (list-slices (nthcdr slice-size things)
-                            slice-size))))
+     (if things
+         (if (> slice-size (len things))
+             (list things)
+             (cons (firstn slice-size things)
+                   (list-slices (nthcdr slice-size things)
+                                slice-size)))
+         nil))
 
 (def intersperse (inbetween things)
   ; return a new list with 'inbetween in between every element of 'things
@@ -43,6 +45,16 @@
                (f items)
                items)))
 
+(assign select collect)
+
+(def compact (things)
+  ; return a new list containing only non-nil items from the given list
+  (collect present? things))
+
+(def +nz args
+  ; return the sum of all non-nil values (consider nil as zero)
+  (apply + (compact args)))
+
 (def reject (f things)
   ; return all the items in 'things for which 'f returns nil
   (collect !f things))
@@ -53,14 +65,13 @@
       (car things)
       (nth (- n 1) (cdr things))))
 
-(mac each (var things code)
+(mac each (var things . body)
   ; repeatedly assigns an element of 'things to 'var,
-  ; and executes 'code each time
+  ; and executes 'body each time
   (w/uniq (xs c)
           `((rfn ,c (,xs)
                 (if (pair? ,xs)
-                    (do
-                        (let ,var (car ,xs) ,code)
+                    (do (let ,var (car ,xs) ,@body)
                         (,c (cdr ,xs)))))
            ,things)))
 
@@ -81,10 +92,10 @@
 
 (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)))))
+  (if (eq? n 0)   nil
+      things      (cons (car things)
+                        (firstn (- n 1)
+                                (cdr things)))))
 
 (def nthcdr (n things)
   ; returns the nth cdr of the list 'things
@@ -155,3 +166,57 @@
 
 (def min things (best < things))
 (def max things (best > things))
+
+(def map-recurse (on-atom on-list things)
+  ((afn (xs)
+    (if (pair? xs)
+        (on-list self xs)
+        xs
+        (on-atom xs)))
+   things))
+
+(def list-gsub (list old new)
+  ; recursively replaces 'old with 'new inside 'list
+  (map-recurse (fn (s) (if (eq? s old) new s))
+               (fn (m things)
+                   (if (eq? things old)
+                       new
+                       (map m things)))
+               list))
+
+(def all? (f things)
+  ; if 'things is a list, true when all items are non-nil
+  ; if 'things is an atom, true when non-nil
+  (if (pair? things)
+      (and (f:car things)
+           (or (no:cdr things)
+               (all? f (cdr things))))
+      (f things)))
+
+(def any? (f things)
+  ; if 'things is a list, true when at least one item is non-nil
+  ; if 'things is an atom, true when non-nil
+  (if (pair? things)
+      (or (f:car things)
+          (and (cdr things)
+               (any? f (cdr things))))
+      (f things)))
+
+(def none? (f things)
+  ; if 'things is a list, true when all items are nil
+  ; if 'things is an atom, true when nil
+  (if (pair? things)
+      (and (no:f:car things)
+           (none? f (cdr things)))
+      (no:f things)))
+
+(def list-match? (matchers things)
+  ; 'matchers is a list of functions
+  ; 'things is a list of items to match
+  ; true when each function in 'matchers returns non-nil for the corresponding value in 'things
+  (if (pair? matchers)
+      (and ((car matchers) (car things))
+           (list-match? (cdr matchers) (cdr things)))
+      matchers
+      (matchers things)
+      t))