nydp 0.4.3 → 0.4.5

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

@@ -1,13 +1,39 @@
+
+;;
+;; problem: work out where a starting column of a form on its starting line, need to add
+;; this amount to its indent if it is broken
+;;
+;; TODO:
+;;
+;; alternative approach: given a form <expr>, ask <expr> recursively
+;; to provide the following:
+;;
+;; { inline: (... <sub-expr> <sub-expr> ...)
+;;   broken: (... <newline "  "> <sub-expr> <newline "  "> <sub-expr> ...)  }
+;;
+;; printer returns <inline> if acceptable, otherwise produces <broken>, recursively deciding on <inline>
+;; for each <sub-expr>
+;;
+;; each <newline "  "> carries the amount of indent required for the containing form, needs to be added to
+;; the amount of indent required for outer forms
+;;
+;;
+;;
+;; also TODO:
+;;
+;; use (module pp ...) and remove all those prefixes...
+;;
+
 (assign pp/special-forms (hash))
 (assign pp/syntaxes      (hash))
 (assign pp/newline       (uniq 'newline))
 (assign pp/newline/noi   (uniq 'newline/noi))
 
+;; (eq? char "\n") "\\n"
 (def pp/esc-ch (char)
   (if (eq? char "\"") "\\\""
       (eq? char "\~") "\\\~"
       (eq? char "\\") "\\\\"
-      (eq? char "\n") "\\n"
       char))
 
 (def pp/esc-str-literal (txt)
@@ -35,11 +61,11 @@
       (isa 'hash thing)          "{ ~(joinstr " " (pp/kv thing)) }"
       (inspect thing)))
 
+;; define a pretty-printer function for forms beginning with the
+;; given name. 'args are usually (form indent), form being the
+;; complete form for pretty-printing, and indent being the current
+;; indent level.
 (mac pp/def (name args . body)
-  ; define a pretty-printer function for forms beginning with the
-  ; 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
                  (fun ,args ,@body))
        (dox-add-doc ',name
@@ -48,6 +74,7 @@
                     ',args
                     '(pp/def ,name ,args ,@body))))
 
+
 (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))" )
@@ -55,7 +82,12 @@
 (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/brace-list-pair (pp (k v) indent) "~k ~(pp v indent)")
+
+(pp/def brace-list (pp form indent)
+  "{ ~(joinstr " " (map λe(pprint e (cons " " indent)) (intersperse-splicing pp/newline (pairs:cdr form)))) }")
 
 (def pp/unsyntax (form)
   (if (pair? form)
@@ -65,15 +97,16 @@
             (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 "=>" )
+(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      "=>" )
+(hash-set pp/syntaxes 'at-syntax          "@"  )
 
 (def pp/dotify (form)
   (if (pair? form)
@@ -160,9 +193,9 @@
       (pprint (pp/break-pair form) indent)
       (pp/literal form indent)))
 
+;; better than (def pp (form) (inspect form))
 (def pp (form) (pp/cleanup:pp/printer (pp/dotify:pp/unsyntax form) nil))
-;; (def pp (form) (inspect form))
 
+;; use the pretty-printer to elegantly display the given source code
 (def dox-show-src (src)
-  ; use the pretty-printer to elegantly display the given source code
   (pp src))

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

@@ -43,7 +43,19 @@
 ; same as (add-hook 'transaction (fn (account amount) (update account total (+ account.total amount))))
 ;
 (mac on (event args . body)
-  `(add-hook ',event (fn ,args ,@body)))
+  (let hookfn (if (isa 'symbol (car body))
+                  (car body)
+                  `(fn ,args ,@body))
+    (w/uniq dox-item
+      `(let ,dox-item (car:dox-lookup ',event)
+         (if (no ,dox-item) (error "unknown hook ~(just ',event)"))
+         (add-hook ',event ,hookfn)
+         (hash-cons ,dox-item 'hooks
+            { src      ',hookfn
+              args     ',args
+              chapter  (chapter-current)
+              file     this-script
+              plugin   this-plugin })))))
 
 (let super warnings/new
   (def warnings/new (kind . info)

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

@@ -21,6 +21,12 @@
 (def safe-sort-by (f instead things)
   (sort-by λi(or (f i) instead) things))
 
+;; takes a function f, returns a new function that takes a list and sorts the list by 'f
+(def sort-by-f (f) (curry1 sort-by f))
+
+;; takes a function f, returns a new function that takes a list and sorts the list by 'f
+(def safe-sort-by-f (f instead) (curry1 safe-sort-by f instead))
+
 (def mapreduce (fmap freduce things)
   ; same as (reduce freduce (map fmap things))
   ; returns the resulting list
@@ -47,9 +53,9 @@
 ; return a list containing all the elements of 'things, but with no duplicates
 (def uniqify (things) (reject (seen?) things))
 
+;; return a hash of 'things keyed by (f thing) for
+;; each thing in 'things
 (def group-by (f things)
-  ; return a hash of 'things keyed by (f thing) for
-  ; each thing in 'things
   (returnlet hsh {}
     (each thing things
           (hash-cons hsh (f thing) thing))))
@@ -64,6 +70,14 @@
         (let mi (m2i anchor)
           (map λm(i2m (+ mi m)) mm))))
 
+;; each call to the name 'accfn-name with an arg will append the arg to the end of a list.
+;; This form returns the resulting list.
+;; Example (collect first names from a list of people)
+;;
+;;   (accum a (each person people (a person.firstname)))
+;;
+;; will return (Alice Bob Carol Declan Eliza Fionn)
+;;
 (mac accum (accfn-name . body)
   (w/uniq (things last-cons)
     `(with (,last-cons (cons) ,things nil)
@@ -72,6 +86,17 @@
          ,@body
          (cdr ,things)))))
 
+;; like 'accum, except 'accfn-name expects 2 args, a key and a value
+;; value is hash-consed onto key in an internally-maintained hash
+;; the form returns the resulting hash
+;; values are in reverse order
+(mac accum-hash (accfn-name . body)
+  (w/uniq (hsh)
+    `(with (,hsh (hash))
+           (let ,accfn-name (fn (k a) (hash-cons ,hsh k a))
+             ,@body
+             ,hsh))))
+
 ; return a list containing the range of elements starting with 'start,
 ; up to but not including 'stop
 (def range (start stop)
@@ -160,3 +185,58 @@
               (acc (car xs))
               (self (cdr xs))))
           things)))
+
+;; returns a list containing 'existing items, that has at least 'minimum items, building new items if necessary
+;;
+;; useful if you want to show, for example, two parent fields, but you don't know in advance whether there
+;; are zero, one, two, or more parents already present
+;;
+;; existing: the existing list
+;; buildf: a zero-argument function to build a new item
+;; minimum: the minimum number of items in the returned list.
+;;
+(def list/fill (existing buildf minimum)
+  (let missing (- minimum (len existing))
+    (if (> missing 0)
+        (+ existing (map buildf (range 0 missing)))
+        existing)))
+
+;; recursively search the given form for forms matching 'matcher
+;; matcher is a function which returns nil for non-match, anything else for match
+;; returns the list of non-nil objects returned by 'matcher
+;; 'matcher will be called with the entire form, and if the form is a list, with each element of the form, recursively
+(def list/grep (matcher form)
+  (accum matches
+    (let maybe λi(if (matcher i) (matches i))
+      (list/traverse maybe maybe form))))
+
+;; recursively seeks forms in 'form whose car is 'symbol
+(def list/seek-cars (symbol form)
+  (list/grep λf(caris symbol f) form))
+
+;; helper function for 'case macro
+(def case/make-conds (test varname conds acc)
+  (if conds
+      (let (cnd expr) (car conds)
+        (if (eq? cnd 'else)
+            (acc expr)
+            (do (acc `(,test ,varname ,cnd))
+                (acc expr)
+                (case/make-conds test
+                                 varname
+                                 (cdr conds)
+                                 acc))))))
+
+;; usage: (case eq? person.name
+;;              "conan" (greet person)
+;;              "egg"   (delete person)
+;;              "bach"  (play person)
+;;              else    (interrogate person))
+(mac case (test what . conditions)
+  (w/uniq caseval
+    `(let ,caseval ,what
+       (if ,@(accum a
+                    (case/make-conds test
+                                     caseval
+                                     (pairs conditions)
+                                     a))))))

data/lib/lisp/core-110-hash-utils.nydp

@@ -15,9 +15,47 @@
   (map-with-index λki(f k (hash-get h k) i)
                   ((or pre x1) (hash-keys h))))
 
+;; returns a new hash with the same keys as the given hash, with each value transformed by
+;; the given function 'f
+;; 'f takes three arguments:
+;; k, the key
+;; v, the value
+;; i, the index
+;;
+(def hash-transform-values (f h pre)
+  (returnlet newh {}
+    (map-hash λkvi(hash-set newh k (f k v i)))))
+
+
 ;; Return a new hash where keys are (map f things) and values are the corresponding things.
 ;; No attempt is made to avoid clobbering items. Use 'group-by if there are duplicate keys.
 (def hashify (f things)
   (returnlet hsh {}
              (each thing things
                    (hash-set hsh (f thing) thing))))
+
+;; like 'group-by, except 'f returns multiple items, each of which
+;; is used to key the thing in question
+(def subgroup-by (f things)
+  (returnlet hsh {}
+    (each thing things
+          (each k (f thing)
+                (hash-cons hsh k thing)))))
+
+;; return a new hash containing all the values of the given
+;; hash, but with each corresponding key 'k replaced by (f k)
+(def hash-replace-keys (f hsh)
+  (returnlet newh {}
+    (each k (hash-keys hsh)
+      (hash-set newh (f k) (hash-get hsh k)))))
+
+;; repeatedly assigns an element of hash-keys of 'things to 'kvar,
+;; assign the corresponding value to 'vvar
+;; and executes 'body for each key-value pair
+;; return value of form is whatever the last line of 'body returns
+(mac hash-each (kvar vvar things . body)
+  (w/uniq xs
+    `(let ,xs ,things
+       (each ,kvar (hash-keys ,xs)
+         (let ,vvar (hash-get ,xs ,kvar)
+           ,@body)))))

data/lib/lisp/core-120-settings.nydp

@@ -1,12 +1,16 @@
 (chapter-start 'settings "Utilities for managing settings")
 
 (assign settings {})
+(assign initial-settings {})
 
 ; convert expr to a function that returns the expr, unless expr is a symbol in which case we assume it already refers to a fn
 (def settings/fn (expr)
-  (if (sym? expr) expr
+  (if (sym? expr)                 expr
       (or (atom? expr) (no expr)) `(k ,expr)
-      `(fn (_) ,expr)))
+      (hash? expr)                `(k ',expr)
+      (caris 'quote expr)         `(k ,expr)
+      (caris 'brace-list expr)    `(k ,expr)
+                                  `(fn (_) ,expr)))
 
 ; update value of setting 'name
 (mac set-setting (name value)
@@ -15,6 +19,10 @@
                   { plugin this-plugin script this-script value ',value })
        (hash-set settings ',(sym name) ,(settings/fn value))))
 
+; update value of setting 'name
+(mac reset-setting (name)
+  `(set-setting ,name ,(hash-get initial-settings (sym name))))
+
 (mac def-setting (name initial)
   ; define a setting in the given 'context with a 'name and an 'initial value, with a 'doc to explain it
   ; if value is a function, it is invoked with 'context and 'name to retrieve its value
@@ -27,6 +35,7 @@
                       '(def-setting ,name ,initial)
                       '(,(sym "settings/~context"))
                       { setting { default ',initial context ',context name ',name } })
+         (hash-set initial-settings ',(sym name) ,initial)
          (set-setting ,(sym name) ,initial))))
 
 ; get the value of the given setting. Raises an error if the setting is unknown

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

@@ -184,24 +184,20 @@
   ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)))
 
 (in-private
-  (def bm-j ()
-    (j "abc" '(d e f (g h i)) (list "jk" "lm")))
+ (def bm-no-closures ()
+   (list λ(+ 1 2)
+         λ(+ 1 2)
+         λ(+ 1 2)
+         λ(+ 1 2)
+         λ(+ 1 2)
+         λ(+ 1 2)
+         λ(+ 1 2)
+         λ(+ 1 2)
+         λ(+ 1 2)
+         λ(+ 1 2)))
 
-  (def bm-or-lex-lex-lex (a b c) (or a b c))
-  (def bm-faster-or ()
-    (bm-or-lex-lex-lex 1 2 3)
-    (bm-or-lex-lex-lex nil 2 3))
-
-  (def build-mapsum-data (count data)
-    (if (> count 0)
-        (build-mapsum-data (- count 1)
-                           (cons { mappit (rand 10) }
-                                 data))
-        data))
-
-  (let mapsum-data (build-mapsum-data 1000)
-    (def bm-mapsum    () (mapsum &mappit mapsum-data))
-    (def bm-mapreduce () (mapreduce &mappit + mapsum-data 0))))
+ (def bm-cons () (cons 'a 'b))
+ (def bm-type-of () (type-of 'a)))
 
 
 
@@ -223,8 +219,12 @@
           (p "================================================\n")
           "~desc : total ~(just times), average ~(/ times repeats) per run"))
 
+
+
 (def rbs (name)
   (let summary nil
+    (push (bm "no-closures    "   bm-no-closures             10  20000) summary)
+    ;; (push (bm "type-of    "   bm-type-of             10  20000) summary)
     ;; (push (bm "accum    "   bm-acc             10  500) summary)
     ;; (push (bm "accum    "   bm-facc            10  500) summary)
     ;; (push (bm "mapsum    "   bm-mapsum             10  100) summary)

data/lib/lisp/tests/accum-examples.nydp

@@ -4,4 +4,31 @@
           (a 1)
           (a 2)
           (a 3))
-   (1 2 3)))
+   (1 2 3))
+
+  ("accum function returns the accumulated object in each case"
+   (let watcher nil
+     (let accumulated (accum b
+                             (= watcher (cons (b 1) watcher))
+                             (= watcher (cons (b 2) watcher))
+                             (= watcher (cons (b 3) watcher)))
+       (list 'watcher watcher 'accumulated accumulated)))
+   (watcher     (3 2 1)
+    accumulated (1 2 3))))
+
+(examples-for accum-hash
+  ("accumulate the values passed to a given function under the given key, return the resulting hash"
+   (let h
+     (accum-hash hi
+                 (hi 'a 1)
+                 (hi 'a 2)
+                 (hi 'b 42)
+                 (hi 'b 43)
+                 (hi 'a 3)
+                 (hi 'b 44)
+                 (hi 'c 'x)
+                 (hi 'a 4)
+                 (hi 'c 'y)
+                 (hi 'c 'z))
+     (list h.a h.b h.c))
+   ((4 3 2 1) (44 43 42) (z y x))))

data/lib/lisp/tests/at-syntax-examples.nydp

@@ -0,0 +1,17 @@
+(examples-for at-syntax
+  ("at-symbol as argument"
+   (let @ {}
+     (= @foo 1)
+     (= @bar 2)
+     (list @foo @bar))
+   (1 2))
+
+  ("at-syntax assignment"
+   (pre-compile '(= @a 42))
+   (hash-set @ 'a 42))
+
+  ("mixed at-syntax and dot-syntax assignment"
+   (pre-compile '(= @a.b 42))
+   (hash-set (hash-get @ 'a) 'b 42)))
+
+;; (let @ {} 123)

data/lib/lisp/tests/best-examples.nydp

@@ -19,6 +19,15 @@
    (best > '(c g d o a p b m e g a z m))
    z)
 
+  ("finds object with max size"
+   (to-string:best (map-compare-f > &size)
+              (list { i 0 size 3 }
+                    { i 1 size 1 }
+                    { i 2 size 7 }
+                    { i 3 size 4 }
+                    { i 4 size 5 }))
+   "{i=>2, size=>7}")
+
   ("finds maximum of list of numbers"
    (best > '(3 5 4 7 8 2))
    8))