nydp 0.4.3 → 0.4.5

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: 1a6a8e0215b81d92423402f9933413c58ebcdad9
-  data.tar.gz: eeb8d8bb621ed6349d2e9d4e7823c3be5e875d04
+  metadata.gz: 1360fe08561240c0e05c70a69629b42b38078275
+  data.tar.gz: 70c0dfe6df1a0b2bf24ef39aca70646d7f8c3cac
 SHA512:
-  metadata.gz: 1f32b55812f569e1329b657eed211054be4e275fcd778671ec7e251fe2b98fc7390531a9742ca819c9eb076aeb9bb34ffd2390c0fd5ebe43ddfc35d75e0eae95
-  data.tar.gz: 2f5cad91e0551afb32c410751c56b11e1b55158218a8bdab8eb5db3d2b38719d3cfb63cc04ca961b7e1436075dbaf10ad3d5d82bf75a61f1fc1d91fd25c03a3f
+  metadata.gz: 5db0e86f33a7ebe4afc33478d1fe6a2da5a6a8d07b85d66532cd155adb9b8b567d6edbe90f3ab0b437f59a03ec2047ca51778c2d0923355131b8e9b718260c83
+  data.tar.gz: 0d4491009c98301ab947668fd396bf7f3544b229de8d1820065073f0bfb01e7db509cba3f749f07f6575b791222d1aa7870c3d0e86d96dce4e95a1ddac8cba00

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

@@ -1,8 +1,11 @@
 (assign mac-expand
         (fn (names macfn expr)
             (cond macfn
-                  (pre-compile-with names
-                                    (apply macfn (cdr expr)))
+                  (handle-error
+                   (fn (errors)
+                       (error "expanding" (inspect expr) "with" (inspect macfn)))
+                   (fn ()
+                       (pre-compile-with names (apply macfn (cdr expr)))))
                   expr)))
 
 (assign macs (hash))
@@ -134,7 +137,3 @@
 
 (hash-set macs 'quasiquote
           (fn (arg) (qq-quasiquote arg 0)))
-
-(hash-set macs 'do
-          (fn args
-              `((fn nil ,@args))))

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

@@ -30,8 +30,9 @@
 (def map (f things)
   (map-helper-1 f things (cons)))
 
+;; push 'v onto the value for 'k in 'h
+;; the hash-values of h will all be lists, in reverse order of consing
 (def hash-cons (h k v)
-  ; push 'v onto the value for 'k in 'h
   (hash-set h k (cons v (hash-get h k))))
 
 (def rev (things last-cdr)

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

@@ -19,6 +19,10 @@
                                  acc)))
       form))
 
+(hash-set macs 'do
+          (fn forms
+              `((fn nil ,@forms))))
+
 ((fn (this-chapter-name chapters chapter-new chapter-build chapter-add-to-chapter)
      (assign chapters (hash))
 
@@ -88,7 +92,7 @@
      (def dox-add-to-chapters (item type chapters)
        (cond chapters
              (do (chapter-add-item    item (car chapters))
-                 (hash-cons types-chapters (cons type (car chapters)) item)
+                 (hash-cons types-chapters (inspect (cons type (car chapters))) item)
                  (dox-add-to-chapters item type (cdr chapters)))
              item))
 
@@ -103,8 +107,10 @@
      (def dox-types () (hash-keys types))
      (def dox-items-by-type (type) (hash-get types type))
 
-     (def dox-items-by-type-and-chapter (type chapter)
-       (hash-get types-chapters (cons type chapter)))
+     (def get-types-chapters () types-chapters)
+
+     (def dox-items-by-type-and-chapter (dox-type chapter)
+       (hash-get types-chapters (inspect (cons dox-type chapter))))
 
      (def dox-get-attr (name attr)
        (cond (dox? name)
@@ -132,9 +138,9 @@
                     (cond (eq? event 'script-end)
                           (script-end name))))))
 
+;; if the car of 'form is a key of 'hsh, add the cdr of 'form to the value of the key in 'hsh
+;; otherwise add the form to the list whose key is nil
 (def filter-form (hsh form)
-  ; if the car of 'form is a key of 'hsh, add the cdr of 'form to the value of the key in 'hsh
-  ; otherwise add the form to the list whose key is nil
   (cond (cond (pair? form)
               (hash-key? hsh (car form)))
       (hash-cons hsh (car form) (cdr form))
@@ -153,9 +159,9 @@
 (def rev-values (hsh)
   (rev-value-keys (hash-keys hsh) hsh (hash)))
 
+;; group forms by their first element, if the first element
+;; is already a key in hsh, collect all other elements under key nil
 (def filter-forms (hsh forms)
-  ; group forms by their first element, if the first element
-  ; is already a key in hsh, collect all other elements under key nil
   (cond forms
         (filter-forms (filter-form hsh (car forms)) (cdr forms))
         (rev-values hsh)))
@@ -165,12 +171,12 @@
   (hash-set hsh 'chapter nil)
   hsh)
 
+;; used internally by 'mac
 (def define-mac-expr (name args body-forms)
-  ; used internally by 'mac
   `(do (hash-set macs ',name (fun ,args ,@(hash-get body-forms nil)))
        (dox-add-doc ',name
                     'mac
-                    ',(map car (hash-get body-forms 'comment))
+                    ',(+ (fetch-and-clear-comments) (map car (hash-get body-forms 'comment)))
                     ',args
                     '(mac ,name ,args ,@(hash-get body-forms nil))
                     ',(map car (hash-get body-forms 'chapter)))))
@@ -195,8 +201,8 @@
 
 (mac def-assign args `(assign ,@args))
 
+;; used internally by 'def
 (def define-def-expr (name args body-forms)
-  ; used internally by 'def
   `(do (def-assign ,name (fun ,args ,@(filter-comments (hash-get body-forms nil))))
        (dox-add-doc ',name
                     'def
@@ -205,8 +211,8 @@
                     '(def ,name ,args ,@(hash-get body-forms nil))
                     ',(map car (hash-get body-forms 'chapter)))))
 
+;; define a new function in the global namespace
 (mac def (name args . body)
-  ; define a new function in the global namespace
   (chapter nydp-core)
   (define-def-expr name args (filter-forms (build-def-hash (hash)) body)))
 

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

@@ -1,4 +1,4 @@
-(assign script-name "core-012-utils.nydp")
+(assign script-name "core-020-utils.nydp")
 
 (dox-add-doc 'if
              'mac
@@ -43,12 +43,12 @@
              '(hash-set h k (cons v (hash-get h k)))
              '(hash-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
 (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

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

@@ -21,16 +21,26 @@ scoping, assignment, anonymous functions and more...")
               (apply orf
                      (cdr args)))))
 
+; returns true if 'things is a list and the first item of the
+; list is the given object
 (def caris (obj things)
-  ; returns true if 'things is a list and the first item of the
-  ; list is the given object
   (and (pair? things)
-       (eq? (car things)  obj)))
+       (eq? (car things) obj)))
 
+; evaluate 'body if 'arg is nil
 (mac unless (arg . body)
-  ; evaluate 'body if 'arg is nil
   `(if (no ,arg) (do ,@body)))
 
+; looks up a key in @
+; assumes local lexical context has defined a hash called '@
+(mac prefix-at-syntax (name . names)
+  `(hash-get @ ',name))
+
+(mac at-syntax names
+  (if (eq? (car names) '||)
+      `(prefix-at-syntax ,@(cdr names))
+      (error "unknown at-syntax: expected prefix-syntax (eg @name), got ~(join-str (car names) "@" (cdr names))")))
+
 (def expand-colon-syntax (names)
   (if (no (cdr names))
           `(apply ,(car names) args)
@@ -89,8 +99,10 @@ scoping, assignment, anonymous functions and more...")
             ,@body)
        ,@(map cadr (pairs parms))))
 
+;; same as ( (fn (var) body) val ) -> ie create a lexical scope
+;; where val is assigned to var, execute 'body in that scope
 (mac let (var val . body)
-     `(with (,var ,val) ,@body))
+  `(with (,var ,val) ,@body))
 
 (mac rfn (name parms . body)
   ; creates a named, locally-scoped function
@@ -120,6 +132,7 @@ scoping, assignment, anonymous functions and more...")
 ;; (fn args (and (apply a args) (apply b args) (apply c args)))
 ;; or more simply
 ;; (fn (x) (and (a x) (b x) (c x)))
+;; note: alias as 'andf ??
 (def andify args
   (fn args2 (rfnwith self (ands args)
                      (if ands (if (apply (car ands) args2)
@@ -234,7 +247,14 @@ scoping, assignment, anonymous functions and more...")
       (caris 'hash-get name)
       (hash-get-assignment (cdr name) value)
       (ampersand-expression? name)
-      (ampersand-expression-assignment name value)))
+      (ampersand-expression-assignment name value)
+      (caris 'at-syntax name)
+      `(hash-set @ ',(caddr name) ,value)
+      (error "unknown assignment to place: ~(inspect name)")))
+
+;; quiet assignment ; like =, but expression returns nil
+(mac #= (name value)
+  `(do (= ,name ,value) nil))
 
 ; increment the value at 'place by 'inc (default 1)
 (mac ++ (place inc) `(= ,place (+ ,place ,(or inc 1))))
@@ -336,12 +356,12 @@ scoping, assignment, anonymous functions and more...")
       (if (hash-get macs args)
           (warnings/new 'arg-shadows-macro "arg " args " shadows macro " args " in arg list " orig " and body " body))))
 
+;; build a 'fn form, changing 'args and 'body to
+;; properly handle any destructuring args if present
 (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 body)
   (destructure/build args nil body))
 
-; assign (f place) to place
+;; assign (f place) to place
 (mac zap (f place . args)
   `(= ,place (,f ,place ,@args)))

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

@@ -40,12 +40,21 @@
        (loop (assign ,v ,gi) (< ,v ,gm) (assign ,v (+ ,v 1))
          ,@body))))
 
-(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 ,@args1 args)))
+;; 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
+;; Could be (mac curry things `(fn args (apply ,@things args))) but less readable
+(mac curry (f . args0)
+  `(fn args
+       (apply ,f ,@args0 args)))
+
+;; like curry, but the returned function takes only a single arg (assumes all
+;; args but one are provided here)
+;; Could be (mac curry1 things `(fn (arg) (,@things arg))) but less readable
+(mac curry1 (f . args)
+  `(fn (arg)
+       (,f ,@args arg)))
 
 (mac cache-get (hsh key val)
   ; if ,key is already in ,hsh - return the associated value.

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

@@ -13,6 +13,17 @@
        (f (car things))
        (eachl f (cdr things))))
 
+;; if things is a pair,
+;;   if (cdr things) is nil, return (car things)
+;;   else recurse on (cdr things)
+;; else return things
+(def list/last (things)
+  (if (pair? things)
+      (aif (cdr things)
+           (list/last it)
+           (car things))
+      things))
+
 ; invokes 'f for each element of 'things, last element processed first
 ; ( "r" in "eachr" = "rightmost first" )
 (def eachr (f things)
@@ -49,3 +60,14 @@
 ; a 'key, returns vx from 'al where kx is equal to 'key
 ; #attribution: lifted almost directly from arc.arc
 (def alref (key al) (cadr (assoc key al)))
+
+;; returns the first non-empty item in 'args
+;; mac equivalent of (detect present? args)
+(mac dp args
+  (if args
+      (w/uniq nearg
+        `(let ,nearg ,(car args)
+           (if (empty? ,nearg)
+               (dp ,@(cdr args))
+               ,nearg)))
+      nil))

data/lib/lisp/core-039-module.nydp

@@ -0,0 +1,24 @@
+;; creates a private namespace for support functions for one or more explicitly exported/public functions
+;;
+;; (module foo
+;;   (def h ...)
+;;   (def u ...)
+;;   (export bar (x y) (h u x y)))
+;;
+;; results in 'foo/bar being universally available, but 'h and 'u are visible only within the module and override
+;; any other 'h or 'u defined elsewhere, in the scope of the module.
+(mac module (module-name . forms)
+  (let private-names nil
+    (let module-forms
+         { def        (fn (name args . body)
+                          (push nil  private-names)
+                          (push name private-names)
+                          `(assign ,name (fn ,args ,@body)))
+           export-def macs.def
+           export     (fn (name args . body)
+                          `(export-def
+                            ,(sym (+ (to-string module-name) "/" (to-string name)))
+                            ,args
+                            ,@body)) }
+      (let module-body (pre-compile-each module-forms forms)
+        `(with (,@private-names) ,@module-body)))))

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

@@ -11,21 +11,20 @@
 (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)
+;; 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"
+(mac just (expr) expr)
 
 (def quotify (arg) `(quote ,arg))
 
-; return a function that always returns 'arg, similar to K in SKI calculus
+;; return a function that always returns 'arg, similar to K in SKI calculus
 (defmemo k (arg) (fn nil arg))
 
+;; return the length of 'things where 'things may be nil, a string, list or hash
+;; length of nil is zero, length of hash is number of keys, length of string
+;; is number of characters, length of list is number of direct items - no recursive counting
 (def len (things)
-  ; return the length of 'things where 'things may be nil, a string, list or hash
-  ; length of nil is zero, length of hash is number of keys, length of string
-  ; is number of characters, length of list is number of direct items - no recursive counting
   (chapter list-manipulation)
   (chapter string-manipulation)
   (chapter hash-manipulation)
@@ -37,8 +36,8 @@
 
 (assign dynamics (hash))
 
+;; creates a dynamic variable.
 (mac dynamic (name initial)
-  ; creates a dynamic variable.
   (let with-mac-name (sym:+ "w/" name)
     (w/uniq prev
       `(do
@@ -53,10 +52,10 @@
          (def ,name () (hash-get (thread-locals) ',name))))))
 
 
-; overrides 'privately defined earlier in documentation manager
+;; overrides 'privately defined earlier in documentation manager
 (dynamic privately)
 
-; suppress documentation of anything defined in 'body
+;; suppress documentation of anything defined in 'body
 (mac in-private body
   `(w/privately t ,@body))
 

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

@@ -30,3 +30,27 @@
 ; return the first 'length chars of string 'str
 (def string-truncate (str length)
   (string-replace "(.{~|length|}).*" "\\1" str))
+
+;; returns a function with args 'args whose body is 'str. 'str should be a string,
+;; 'args should correspond to interpolations within 'str
+;;
+;; example: (string-eval-fn "hello \~u.firstname" 'u)
+;; returns (fn (u) (string-pieces "hello " u.firstname))
+(defmemo string-eval-fn (str args)
+  (eval `(fn ,args
+             ,(parse-in-string str))))
+
+;; assigns 'args respectively to 'arg-names and evals 'str in that context.
+;; Assumes 'str contains interpolations which reference 'arg-names.
+;; Useful for evaluating user-supplied strings ; dangerous for the same reason.
+;;
+;; example: (string/eval-with-args "\~x + \~y is \~(+ x y)" '(x y) 2 3)
+;; returns "2 + 3 is 5"
+;;
+(def string/eval-with-args (str arg-names . args)
+  (on-err
+   (error (j "error evaluating "  (inspect str)
+             "\nwith arg names "  (inspect arg-names)
+             "\nand args "        (inspect args)))
+   (apply (string-eval-fn str arg-names)
+          args)))

data/lib/lisp/core-042-date-utils.nydp

@@ -7,3 +7,19 @@
 ;; return a Time object representing the time 's seconds ago
 (def seconds-ago (s)
   (- (time) s))
+
+(def anniversary/previous (anchor anniv)
+  (let d (date anchor.year
+               anniv.month
+               anniv.day)
+    (if (< d anchor)
+        d
+        d.last-year)))
+
+(def anniversary/next (anchor anniv)
+  (let d (date anchor.year
+               anniv.month
+               anniv.day)
+    (if (> d anchor)
+        d
+        d.next-year)))

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

@@ -23,75 +23,71 @@
              (intersperse inbetween (cdr things)))
       things))
 
+;; expects 'things a list of lists, joins the lists
+;; returns (a b X c d X e f)
+;; placing 'inbetween in between each list.
+;; For example (intersperse-splicing 'X '((a b) (c d) (e f)))
 (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 collect (f things)
-  ; 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
-               (pair? items)
-               (if (f (car items))
-                   (cons (car items)
-                         (collector (cdr items)))
-                   (collector (cdr items)))
-               (f items)
-               items)))
+;; 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...
+(def collect (f items)
+  (if (pair? items)
+      (if (f (car items))
+          (cons (car items)
+                (collect f (cdr items)))
+          (collect f (cdr items)))
+      items
+      (if (f items)
+          items)))
 
 (assign select collect)
 
-; return a new list containing only 'present? items from the given list
+;; return a new list containing only 'present? items from the given list
 (def compact (things) (collect present? things))
 
+;; return the sum of all non-nil values (consider nil as zero)
 (def +nz args
-  ; return the sum of all non-nil values (consider nil as zero)
   (apply + (compact args)))
 
+;; return all the items in 'things for which 'f returns nil
 (def reject (f things)
-  ; return all the items in 'things for which 'f returns nil
   (collect !f things))
 
+;; returns the n-th item in the list 'things
 (def nth (n things)
-  ; returns the n-th item in the list 'things
   (if (eq? n 0)
       (car things)
       (nth (- n 1) (cdr things))))
 
+;; repeatedly assigns an element of 'things to 'var,
+;; and executes 'body each time
 (mac each (var things . body)
-  ; repeatedly assigns an element of 'things to 'var,
-  ; and executes 'body each time
   (w/uniq (xs c)
-          `((rfn ,c (,xs)
-                (if (pair? ,xs)
-                    (do (let ,var (car ,xs) ,@body)
-                        (,c (cdr ,xs)))))
-           ,things)))
+          `(rfnwith ,c (,xs ,things)
+               (if (pair? ,xs)
+                   (do (let ,var (car ,xs) ,@body)
+                       (,c (cdr ,xs)))))))
 
 (def reduce (f things)
-  ((rfn rd (acc list)
-        (if (pair? list)
-            (rd (f acc (car list))
-                (cdr list))
-            acc))
-   (car things) (cdr things)))
-
+  (rfnwith rd (acc (car things) list (cdr things))
+           (if (pair? list)
+               (rd (f acc (car list))
+                   (cdr list))
+               acc)))
+
+;; t if this is a proper list (last cdr is nil)
+;; nil otherwise (last cdr is neither cons nor nil)
 (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)))))
 
+;; returns the first 'n items in the list 'things
 (def firstn (n things)
-  ; returns the first 'n items in the list 'things
   (if (eq? n 0)   nil
       things      (cons (car things)
                         (firstn (- n 1)
@@ -139,25 +135,39 @@
       (detect (curry eq? f)
               things)))
 
+;; split things into a list of lists each n long
 (def tuples (n things)
-  ;; split things into a list of lists each n long
   (rfnwith _ (list things)
            (if (no list)
                nil
                (cons (firstn n list) (_ (nthcdr n list))))))
 
-(def best (f things)
-  (if (no things)
-      nil
-      (let winner (car things)
-        (each thing (cdr things)
-              (if (f thing winner)
-                  (= winner thing)))
-        winner)))
+;; iterates through 'things pairwise (a,b then b,c then c,d etc), returns whichever is preferred by 'better-p
+;; example (best > '(3 1 4 1 5 9 2)) returns 9
+;; "better-p" -> takes two args a and b, return t if a is "better" than b, nil otherwise
+(def best (better-p things)
+  (reduce (fn (a b)
+              (if (better-p a b) a b))
+          things))
 
 (def min things (best < things))
 (def max things (best > things))
 
+;; returns a function taking two args a and b, that compares attributes of two objects
+;; 'map-f takes one arg a returning a1
+;; 'compare-p takes two args a1 and b1, returns t if a1 is "better" than b1
+;;
+;; useful in conjunction with 'best : (best (map-compare-f > &size) (list { size 1 } { size 7 } { size 3 })) returns { size 7 }
+(def map-compare-f (compare-p map-f)
+  (fn (a b) (compare-p (map-f a) (map-f b))))
+
+;; iterate over 'things, calling 'on-atom for each non-list element, and calling
+;; 'on-list for each list element.
+;; 'on-atom takes one parameter, the element in question;
+;; 'on-list takes two parameters: a function to call for recursing, and the list in question.
+;; 'on-list should be something like (fn (rec xs) (foo xs) (map rec xs)) to construct a new list,
+;; or (fn (rec xs) (foo xs) (eachl rec xs)) to iterate without constructing a new list
+;; see 'list-gsub for an example of constructing a new list using this.
 (def map-recurse (on-atom on-list things)
   ((afn (xs)
     (if (pair? xs)
@@ -166,8 +176,20 @@
         (on-atom xs)))
    things))
 
+;; like map-recurse, but doesn't depend on caller to initiate recursion
+;; 'on-atom and 'on-list are functions each taking one parameter
+;; return value is last returned item from on-atom or on-list
+(def list/traverse (on-atom on-list things)
+  (map-recurse
+   (fn (s)
+       (on-atom s))
+   (fn (rec xs)
+       (on-list xs)
+       (eachl rec xs))
+   things))
+
+;; recursively replaces 'old with 'new inside 'list
 (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)