nydp 0.5.1 → 0.6.0

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

@@ -16,7 +16,7 @@
                                 `(cond ,(car args) ,(cadr args)))
                           (car args))
                     nil)
-             '(flow-control))
+             (dox/attrs (flow-control)))
 
 (dox-add-doc 'map
              'def
@@ -27,21 +27,23 @@
                   (cons (f (car things)) (map f (cdr things)))
                   things
                   (f things))
-             '(list-manipulation))
+             (dox/attrs (list-manipulation)))
 
 (dox-add-doc 'rev
              'def
-             '("returns 'things in reverse order")
+             '("@things@ - the list to be reversed"
+               "@last-cdr@ - (normally nil) - an item (atom, list, nil, anything) "
+               "to be consed to the end of the reversed list.")
              '(things)
-             '(if (pair? things) (rev (cdr things) (cons (car things) last-cdr)) last-cdr)
-             '(list-manipulation))
+             '(def rev (things last-cdr) (loop (pair? things) ((fn nil (assign last-cdr (cons (car things) last-cdr)) (assign things (cdr things))))) last-cdr)
+             (dox/attrs (list-manipulation)))
 
 (dox-add-doc 'hash-cons
              'def
              '("push 'v onto the value for 'k in 'h")
              '(h k v)
              '(hash-set h k (cons v (hash-get h k)))
-             '(hash-manipulation))
+             (dox/attrs (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
@@ -56,3 +58,28 @@
                 joint
                 (cdr things))
       prefix))
+
+;; returns the 'thing if the 'thing is present? ; otherwise nil
+;; useful for compressing forms like
+;;
+;; (let thing (get-the-thing)
+;;   (if (present? thing)
+;;     (do-thing-stuff thing)))
+;;
+;; down to
+;;
+;; (aif (nb thing) (do-thing-stuff it))
+;;
+;;
+;; or, alternatively, compressing
+;;
+;; (let thing (get-the-thing)
+;;   (if (present? thing)
+;;       thing
+;;       (get-the-other-thing)))
+;;
+;; down to
+;;
+;; (or (nb (get-the-thing)) (get-the-other-thing))
+;;
+(def nb (thing) (if (present? thing) thing nil))

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

@@ -6,8 +6,8 @@
 
 (warnings/clear)
 
+;; apply f to each stored warning. For example, (warnings p) to print warnings to console
 (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)

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

@@ -106,17 +106,17 @@ scoping, assignment, anonymous functions and more...")
 (mac let (var val . body)
   `((fun (,var) ,@body) ,val))
 
+;; creates a named, locally-scoped function
+;; with the given parameter names. It is possible
+;; to reference the function by its name from within
+;; the function (to pass as an argument or for
+;; recursive invocation)
 (mac rfn (name parms . body)
-  ; creates a named, locally-scoped function
-  ; with the given parameter names. It is possible
-  ; to reference the function by its name from within
-  ; the function (to pass as an argument or for
-  ; recursive invocation)
   `(let ,name nil
      (assign ,name (fn ,parms ,@body))))
 
+;; same as @rfn@, but using the name @self@
 (mac afn (parms . body)
-  ; same as 'rfn, but using the name 'self
   `(rfn self ,parms ,@body))
 
 ;; a mix of rfn and with; creates a locally-scoped named function with
@@ -130,23 +130,17 @@ scoping, assignment, anonymous functions and more...")
        (assign ,name (fun ,(map car ppairs) ,@body))
        (,name ,@(map cadr ppairs)))))
 
-;; (andify a b c) is equivalent to
-;; (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)
-                                  (self (cdr ands)))
-                         t))))
-
-(let 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)))
+;; increments a counter and appends it to prefix
+;; return value should be unique until @unique-counter@ is reset
+;; @unique-counter@ is reset before compiling a new expression, so under normal circumstances,
+;; the returned value is unique within an expression, but not across the entire system.
+;; Don't use these values for global variables!
+(def uniq (prefix)
+  (assign uniq-counter (+ uniq-counter 1))
+  (sym (join-str prefix "-" (list uniq-counter))))
+
+(def reset-uniq-counter ()
+  (assign uniq-counter 0))
 
 ;; creates a lexical scope with a unique symbol assigned to
 ;; each variable in 'vars ; executes the 'body.
@@ -156,9 +150,19 @@ scoping, assignment, anonymous functions and more...")
              ,@body)
       `(let ,vars (uniq ',vars) ,@body)))
 
+;; @(andify a b c)@ is equivalent to
+;; @(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 ??
+(mac andify args
+  (w/uniq a2
+      `(fn ,a2
+           (and ,@(map (fn (a) `(apply ,a ,a2)) args)))))
+
+;; lazy-evaluates each argument, returns the first
+;; non-nil result, or nil if all evaluate to nil.
 (mac or args
-  ; lazy-evaluates each argument, returns the first
-  ; non-nil result, or nil if all evaluate to nil.
   (if (cdr args)
       (let arg (car args)
         (if (isa 'symbol arg)
@@ -184,8 +188,8 @@ scoping, assignment, anonymous functions and more...")
           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
@@ -198,12 +202,12 @@ scoping, assignment, anonymous functions and more...")
 (mac hash-lookup (names)
   (build-hash-getters names nil))
 
+;; parser expands a.b to (dot-syntax a b)
 (mac dot-syntax names
-  ; parser expands a.b to (dot-syntax a b)
   `(hash-lookup ,names))
 
+;; parser expands a$b to (dollar-syntax a b)
 (mac dollar-syntax (_ name)
-  ; parser expands a$b to (dollar-syntax a b)
   `(,name))
 
 (def dot-syntax-assignment (names value-expr)
@@ -293,13 +297,16 @@ scoping, assignment, anonymous functions and more...")
 (mac #= (name value)
   `(do (= ,name ,value) nil))
 
-; increment the value at 'place by 'inc (default 1)
+;; increment the value at 'place by 'inc (default 1)
 (mac ++ (place inc) `(= ,place (+ ,place ,(or inc 1))))
 
-; override previous definition to allow expressions like (def hsh.foo (arg arg2) ...)
+;; decrement the value at 'place by 'inc (default 1)
+(mac -- (place inc) `(= ,place (- ,place ,(or inc 1))))
+
+;; override previous definition to allow expressions like (def hsh.foo (arg arg2) ...)
 (mac def-assign args `(= ,@args))
 
-; evaluate ,val and assign result to ,place only if ,place is already nil
+;; evaluate ,val and assign result to ,place only if ,place is already nil
 (mac or= (place val) `(or ,place (= ,place ,val)))
 
 (def brace-list-hash-key (k)
@@ -307,33 +314,34 @@ scoping, assignment, anonymous functions and more...")
       (caris 'unquote k)   (cadr k)
       k))
 
+;; TODO instead expand to: (hash 'k1 v1 'k2 v2 'k3 v3 ...)
+;; TODO builtin-hash function takes care of constructing the hash
 (def brace-list-build-hash (args)
-  (w/uniq hash
-    (let mappings (pairs args)
-      `(let ,hash (hash)
-            ,@(map (fn (m) `(hash-set ,hash ,(brace-list-hash-key (car m)) ,(cadr m))) mappings)
-            ,hash))))
+  `(hash ,@(apply
+            +
+            (map (fn (kv) (list (brace-list-hash-key (car kv)) (cadr kv)))
+                 (pairs args)))))
 
 (def build-ampersand-syntax (arg)
   (if (caris 'dot-syntax arg)
       `(fn (obj) ,(build-hash-lookup-from 'obj (cdr arg)))
       `(fn (obj) ,(build-hash-lookup-from 'obj (list arg)))))
 
+;; parser expands a&b to (ampersand-syntax a b)
 (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 ~(join-str pfx "&" rest)"))
   (if (cdr rest)
       (error "Irregular '& syntax: got suffix ~(inspect (cdr rest)) in ~(join-str pfx "&" rest)")
       (build-ampersand-syntax (car rest))))
 
-; override 'brace-list-mono in order to provide a useful interpretation for "{ x }" syntax
+;; override 'brace-list-mono in order to provide a useful interpretation for "{ x }" syntax
 (mac brace-list-mono (arg) arg)
 
-; interprets "{ }" as new hash
+;; interprets "{ }" as new hash
 (mac brace-list-empty () '(hash))
 
-; parser expands { foo bar } to (brace-list foo bar)
+;; parser expands { foo bar } to (brace-list foo bar)
 (mac brace-list args
   (if (no args)
       `(brace-list-empty)
@@ -341,13 +349,13 @@ scoping, assignment, anonymous functions and more...")
       `(brace-list-mono ,(car args))
       (brace-list-build-hash args)))
 
-; stores ,val in ,var, executes ,@body, returns ,var. Saves a line of code at the end of
-; 'let. If 'body assigns to 'var, the assigned value of 'var will be returned. See also 'returning
+;; stores ,val in ,var, executes ,@body, returns ,var. Saves a line of code at the end of
+;; 'let. If 'body assigns to 'var, the assigned value of 'var will be returned. See also 'returning
 (mac returnlet (var val . body) `(let ,var ,val ,@body ,var))
 
-; stores ,val, executes ,@body, and returns ,val. Assumes 'body is going to do something
-; destructive with 'val, but you want 'val before it gets changed. Note that if 'val is mutated
-; (eg hash), the mutated value will be returned. See also 'returnlet
+;; stores ,val, executes ,@body, and returns ,val. Assumes 'body is going to do something
+;; destructive with 'val, but you want 'val before it gets changed. Note that if 'val is mutated
+;; (eg hash), the mutated value will be returned. See also 'returnlet
 (mac returning (val . body) (w/uniq retval `(returnlet ,retval ,val ,@body)))
 
 (mac ifv (var expr . body)
@@ -363,11 +371,19 @@ scoping, assignment, anonymous functions and more...")
 (mac aif (expr . body)
   `(ifv it ,expr ,@body))
 
+;; returns the nth cdr of the list 'things
+(def nthcdr (n things)
+  (loop (> n 0)
+    (= things (cdr things)
+      n (- n 1)))
+  things)
+
 ;; returns the n-th item in the list 'things
 (def nth (n things)
-  (if (eq? n 0)
-      (car things)
-      (nth (- n 1) (cdr things))))
+  (loop (> n 0)
+    (= things (cdr things)
+      n (- n 1)))
+  (car things))
 
 (def destructure/with (var args n)
   ; provides the argument expression to 'with when

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

@@ -4,40 +4,33 @@
   ; executes 'body. If an error is raised, executes 'handler. Inside
   ; '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)))
+  `(handle-error (fn (errors traces) ,handler)
+                 (fn ()              ,@body)))
 
+;; executes 'body. Afterwards, executes 'protection.
+;; 'protection is always executed even if there is an error.
 (mac ensure (protection . body)
-  ; executes 'body. Afterwards, executes 'protection.
-  ; 'protection is always executed even if there is an error.
   `(ensuring (fn () ,protection)
              (fn ()    ,@body)))
 
 ;; tests 'test, as long as 'test is non-nil,
 ;; repeatedly executes 'body
 (mac while (test . body)
-  (w/uniq (rfname pred)
-    `(rfnwith ,rfname (,pred ,test)
-        (when ,pred
-          ,@body
-          (,rfname ,test)))))
+  `(loop ,test (do ,@body)))
 
-(mac loop (start test update . body)
-  ; execute 'start, then for as long as 'test returns non-nil,
-  ; execute 'body and 'update
-  (w/uniq (gfn gparm)
-    `(do ,start
-         ((rfn ,gfn (,gparm)
-            (if ,gparm
-                (do ,@body ,update (,gfn ,test))))
-          ,test))))
+;; execute 'start, then for as long as 'test returns non-nil,
+;; execute 'body and 'update
+(mac looping (start test update . body)
+  `(do
+     ,start
+     (while ,test ,@body ,update)))
 
+;; assign 'init to 'v, then execute 'body 'max times,
+;; incrementing 'v at each iteration
 (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))
+       (looping (assign ,v ,gi) (< ,v ,gm) (assign ,v (+ ,v 1))
          ,@body))))
 
 ;; return a new function which is the original function with
@@ -56,14 +49,13 @@
   `(fn (arg)
        (,f ,@args arg)))
 
+;; 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
 (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)))))))
+  (w/uniq (h k)
+    `(with (,h ,hsh ,k ,key)
+       (or= (hash-get ,h ,k) ,val))))
 
 ;; same as 'def, but caches the result, keyed on args, so for a given set of args the result
 ;; is only ever calculated once

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

@@ -9,40 +9,103 @@
 ; invokes 'f for each element of 'things, first element processed first
 ; ( "l" in "eachl" = "leftmost first" )
 (def eachl (f things)
-     (when things
-       (f (car things))
-       (eachl f (cdr things))))
+  (loop (pair? things)
+        (do
+            (f (car things))
+            (= things (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))
+;;
+;; 'it is used internally
+;;
+(def list/last (things it)
+  (loop (pair? things)
+        (= it     (car things)
+           things (cdr things)))
+  (or things it))
+
+;; finds the index in 'things for which 'f returns non-nil,
+;; or nil if not found
+(def list/find-index (f things)
+  (with (found nil
+         i     -1)
+    (loop (and things
+               (no found))
+     (= found  (f (car things))
+        things (cdr things)
+        i      (+ i 1)))
+    (and found i)))
+
+;; finds the index of 'thing in a list 'things, such that for example,
+;; given a list 'my-list and an item 'thingy in the list,
+;; (nth (list/index-of thingy my-list) my-list) will return the value of thingy.
+;; returns nil if not found
+(def list/index-of (thing things)
+  (list/find-index
+    (fn (it) (eq? it thing))
+    things))
+
+;; given a number 'n and a list 'things, return (a b) where a is
+;; the item at index n-1 or nil if not possible, and b is the item
+;; at index n+1 or nil if not possible
+(def list/around (n things)
+  (if (and n
+           (< -1 n (len things)))
+      (list
+        (and (> n 0)
+             (nth (- n 1) things))
+        (nth (+ n 1) things))
+      (list nil nil)))
+
+;; finds the item before and the item after the given item in the  given list.
+;; For example,
+;; (list/around λx(eq? x 'd) '(a b c d e f) ) will return '(c e)
+(def list/around-f (f things)
+  (list/around
+    (list/find-index f things)
+    things))
+
+;; finds the item before and the item after the given item in the  given list.
+;; For example,
+;; (list/around '(a b c d e f) 'd) will return '(c e)
+(def list/around-thing (thing things)
+  (list/around
+    (list/index-of thing things)
+    things))
 
 ; invokes 'f for each element of 'things, last element processed first
 ; ( "r" in "eachr" = "rightmost first" )
 (def eachr (f things)
-     (when things
-       (eachr f (cdr things))
-       (f (car things))))
+  (eachl f (rev things)))
 
 ; assign (cons x things) to things
-(mac push (x things) `(= ,things (cons ,x ,things)))
+(mac push (x things)
+  `(= ,things (cons ,x ,things)))
+
+;; used internally by 'flatmap
+(def flatmap-helper (f things res)
+  (loop (pair? things)
+    (let a (car things)
+      (= res
+         (if (pair? a)
+             (flatmap-helper f a res)
+             a
+             (cdr-set res (cons (f a)))
+             res)
+         things
+         (cdr things))))
+  (if things
+      (= res (set-cdr res (f things))))
+  res)
 
-; flatten the given list, transforming each leaf-item, recursively
+;; flatten the given list, transforming each leaf-item, recursively
 (def flatmap (f things)
-     (let acc nil
-          (rfnwith flattenize (x things)
-                   (if (pair? x)
-                       (eachr flattenize x)
-                       x
-                       (push (f x) acc)))
-          acc))
+  (let res (cons)
+    (flatmap-helper f things res)
+    (cdr res)))
 
 ; flatten the given list, recursively
 (def flatten (things) (flatmap x1 things))

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

@@ -59,16 +59,16 @@
 (mac in-private body
   `(w/privately t ,@body))
 
+;; 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
+;; usage: (mapx items v (to-string v)) equivalent to (map to-string items)
 (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
-  ; usage: (mapx items v (to-string v)) equivalent to (map to-string items)
   (chapter list-manipulation)
   `(map (fun (,x) ,expr) ,things))
 
+;; 't if 'thing is not nil or a list or a hash
 (def atom? (thing)
-  ; 't if 'thing is not a list or a hash
   (chapter nydp-core)
   (and thing
        (!pair? thing)
@@ -93,6 +93,8 @@
 
 ;; returns the first non-empty item in 'args
 ;; mac equivalent of (detect present? args)
+;; useful to obtain a non-blank value from a set of variables, for example
+;; (%span.name (dp {first} {last} {email} "unknown"))
 (mac dp args
   (if args
       (w/uniq nearg
@@ -108,6 +110,7 @@
 ;;   (p (c))           ;;=> 1
 ;;   (p (c)))          ;;=> 2
 ;;
+;; see also 'seqf which does almost exactly the same thing
 (def counter ()
   (let i -1
     (fn () (++ i))))

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

@@ -4,26 +4,26 @@
 (def string-strip (txt)
   (string-replace "(\\A\\s+|\\s+\\z)" "" txt))
 
+;; 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
 (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 (map (fn (x) (list txt x))
                          (cdr joinables))))))
 
-; stringify join all the things and join them with no separator, like (joinstr "" things)
+;; stringify join all the things and join them with no separator, like (joinstr "" things)
 (def j things
-  (apply + (flatmap to-string things)))
+  (apply + "" (flatmap to-string things)))
 
-; string-interpolation syntax emits this form. Default implementation
-; is to delegate to 'j , but containing forms may use macros that
-; override this in order to provide specific interpolation behaviour
-; (for example, formatting numbers or stripping HTML tags)
+;; string-interpolation syntax emits this form. Default implementation
+;; is to delegate to 'j , but containing forms may use macros that
+;; override this in order to provide specific interpolation behaviour
+;; (for example, formatting numbers or stripping HTML tags)
 (def string-pieces pieces
   (j pieces))
 
@@ -54,3 +54,9 @@
              "\nand args "        (inspect args)))
    (apply (string-eval-fn str arg-names)
           args)))
+
+;; if txt is not blank/empty, return concatenation of before, txt, after
+(def maybe-wrap-text (txt before after)
+  (if (nb txt)
+      (j before txt after)
+      txt))