nydp 0.4.1 → 0.4.2

Sign up to get free protection for your applications and to get access to all the features.
Files changed (44) hide show
  1. checksums.yaml +4 -4
  2. data/lib/lisp/core-012-utils.nydp +19 -5
  3. data/lib/lisp/core-015-documentation.nydp +6 -3
  4. data/lib/lisp/core-017-builtin-dox.nydp +35 -30
  5. data/lib/lisp/core-030-syntax.nydp +24 -23
  6. data/lib/lisp/core-035-flow-control.nydp +3 -3
  7. data/lib/lisp/core-037-list-utils.nydp +24 -14
  8. data/lib/lisp/core-040-utils.nydp +22 -14
  9. data/lib/lisp/core-041-string-utils.nydp +12 -8
  10. data/lib/lisp/core-043-list-utils.nydp +3 -9
  11. data/lib/lisp/core-045-dox-utils.nydp +5 -0
  12. data/lib/lisp/core-100-utils.nydp +27 -12
  13. data/lib/lisp/core-110-hash-utils.nydp +7 -0
  14. data/lib/lisp/core-120-settings.nydp +35 -0
  15. data/lib/lisp/{core-060-benchmarking.nydp → core-900-benchmarking.nydp} +47 -17
  16. data/lib/lisp/tests/cdr-set-examples.nydp +6 -0
  17. data/lib/lisp/tests/date-examples.nydp +2 -0
  18. data/lib/lisp/tests/foundation-test.nydp +12 -0
  19. data/lib/lisp/tests/hash-examples.nydp +1 -1
  20. data/lib/lisp/tests/set-intersection-examples.nydp +16 -0
  21. data/lib/lisp/tests/set-union-examples.nydp +8 -0
  22. data/lib/lisp/tests/settings-examples.nydp +24 -0
  23. data/lib/lisp/tests/sort-examples.nydp +8 -0
  24. data/lib/lisp/tests/string-tests.nydp +9 -0
  25. data/lib/lisp/tests/zap-examples.nydp +12 -0
  26. data/lib/nydp.rb +3 -4
  27. data/lib/nydp/builtin/cdr_set.rb +1 -6
  28. data/lib/nydp/builtin/handle_error.rb +1 -1
  29. data/lib/nydp/builtin/hash.rb +3 -44
  30. data/lib/nydp/core_ext.rb +41 -0
  31. data/lib/nydp/date.rb +18 -20
  32. data/lib/nydp/hash.rb +5 -6
  33. data/lib/nydp/helper.rb +9 -25
  34. data/lib/nydp/string_atom.rb +14 -19
  35. data/lib/nydp/symbol.rb +40 -27
  36. data/lib/nydp/truth.rb +9 -2
  37. data/lib/nydp/version.rb +1 -1
  38. data/lib/nydp/vm.rb +0 -2
  39. data/spec/date_spec.rb +22 -22
  40. data/spec/hash_non_hash_behaviour_spec.rb +2 -2
  41. data/spec/spec_helper.rb +4 -1
  42. data/spec/symbol_spec.rb +31 -0
  43. data/spec/time_spec.rb +1 -1
  44. metadata +9 -3
checksums.yaml CHANGED
@@ -1,7 +1,7 @@
1
1
  ---
2
2
  SHA1:
3
- metadata.gz: 858b22d67ba13ec86efe8a00fd10b5fa813aee8c
4
- data.tar.gz: 24876cc3c6e1389f656640d3548574d7241b3725
3
+ metadata.gz: 93571312813f5383bd47d92b298cd95b0239f07e
4
+ data.tar.gz: 242349e0186b701a602e94cbfdba9a1adfb5d5bb
5
5
  SHA512:
6
- metadata.gz: 2c0094a86976f2272a70b9c5ea8b76e36face05f089ad9c7a0d51c3de251081230ce85d37e11f9ccaf23cd3d0433a655464d9193dfba37f1e1526fd929e03a13
7
- data.tar.gz: 9eb38db6a571768e8da0bdddbd6420e7627f492748aa64aac0e8e48e08c9af416da84c5be0b8e3828559d1988de250f9f72eaa3d25166f5001c7a1896a9d8203
6
+ metadata.gz: 47e4c03909bcc94e0440d35f6a8e4f3cf36241832a89042456d18d556c6f8a34953d10382e2b5c17df6d28a7c530f9347c505cb6cf66931b9dcf18b34c2df88d
7
+ data.tar.gz: c899014050d46f2a093dec88a62f6a44ff70fffdd6bc66392338c33699f49c92e4ef0239d49e337685190757b318409d614a9319463dedd0bba1883526e78dc6
@@ -8,13 +8,27 @@
8
8
  (car args))
9
9
  nil)))
10
10
 
11
- (def map (f things)
12
- ; transforms the list 'things by applying 'f to each item
13
- ; returns the resulting list
11
+ (def map-helper-0 (f things lc _)
14
12
  (if (pair? things)
15
- (cons (f (car things)) (map f (cdr things)))
13
+ (map-helper-0 f (cdr things) (cdr-set lc (cons (f (car things)))))
16
14
  things
17
- (f things)))
15
+ (cdr-set lc (f things))))
16
+
17
+ (def map-helper-1 (f things acc)
18
+ (map-helper-0 f things acc)
19
+ (cdr acc))
20
+
21
+ ;; transforms the list 'things by applying 'f to each item, returns the resulting list
22
+ ;; conceptually, does the following:
23
+ ;;
24
+ ;; (if (pair? things)
25
+ ;; (cons (f (car things)) (map f (cdr things)))
26
+ ;; things
27
+ ;; (f things))
28
+ ;;
29
+ ;; however the actual version is more complicated to allow for TCO ("modulo-cons" issue)
30
+ (def map (f things)
31
+ (map-helper-1 f things (cons)))
18
32
 
19
33
  (def hash-cons (h k v)
20
34
  ; push 'v onto the value for 'k in 'h
@@ -64,7 +64,7 @@
64
64
  (assign this-script nil)
65
65
  (assign this-plugin "Nydp Core")
66
66
 
67
- ((fn (dox examples chapters dox-new dox-build)
67
+ ((fn (dox examples chapters types dox-new dox-build)
68
68
  (def dox-build (hsh name what texts args src chapters)
69
69
  (hash-set hsh 'name name )
70
70
  (hash-set hsh 'what what )
@@ -78,6 +78,7 @@
78
78
 
79
79
  (def dox-new (item)
80
80
  (hash-cons dox (hash-get item 'name) item)
81
+ (hash-cons types (hash-get item 'what) item)
81
82
  (dox-add-to-chapters item (hash-get item 'chapters)))
82
83
 
83
84
  (def dox-add-doc (name what texts args src chapters more)
@@ -93,11 +94,13 @@
93
94
  (def dox-add-examples (name example-exprs)
94
95
  (hash-cons examples name example-exprs))
95
96
 
96
- (def dox-lookup (sym) (hash-get dox sym))
97
+ (def dox-lookup (name) (hash-get dox name))
97
98
 
98
99
  (def dox? (sym) (hash-key? dox sym))
99
100
 
100
101
  (def dox-names () (hash-keys dox))
102
+ (def dox-types () (hash-keys types))
103
+ (def dox-items-by-type (type) (hash-get types type))
101
104
 
102
105
  (def dox-get-attr (name attr)
103
106
  (cond (dox? name)
@@ -108,7 +111,7 @@
108
111
  (def dox-examples (name) (hash-get examples name ))
109
112
  (def dox-args (name) (dox-get-attr name 'args ))
110
113
  (def dox-example-names () (hash-keys examples )))
111
- (hash) (hash) (hash) nil)
114
+ (hash) (hash) (hash) (hash) nil)
112
115
 
113
116
  (def plugin-start (name) (assign this-plugin name) (chapter-end))
114
117
  (def plugin-end (name) (assign this-plugin nil ) (chapter-end))
@@ -60,34 +60,39 @@
60
60
  "Otherwise, expect 3, 4, 5, or 6 args, to construct a time from"
61
61
  "year, month, date, hours, minutes, seconds, milliseconds, reading arguments in that order,"
62
62
  "where hours, minutes, seconds, and milliseconds are optional") 'args nil '(date-time))
63
- (dox-add-doc 'thread-locals 'def '("return a hash bound to the current thread") nil nil '(nydp-core))
64
- (dox-add-doc 'type-of 'def '("return a symbol for the type of 'arg") '(arg) nil '(nydp-core))
65
- (dox-add-doc 'eq? 'def '("return 't if 'arg-0 and 'arg-1 are equal, nil otherwise") '(arg-0 arg-1) nil '(nydp-core))
66
- (dox-add-doc 'cdr-set 'def '("set the cdr of the given 'cell to 'arg, returns 'cell") '(cell arg) nil '(list-manipulation))
67
- (dox-add-doc 'hash-get 'def '("return the value stored by 'key in 'hsh") '(hsh key) nil '(hash-manipulation))
68
- (dox-add-doc 'hash-set 'def '("store 'val under 'key in 'hsh, return 'val") '(hsh key val) nil '(hash-manipulation))
69
- (dox-add-doc 'hash-keys 'def '("return the list of keys in 'hsh") '(hsh) nil '(hash-manipulation))
70
- (dox-add-doc 'hash-key? 'def '("return 't if 'key is a key of 'hsh") '(hsh key) nil '(hash-manipulation))
71
- (dox-add-doc 'hash-merge 'def '("return a new hash containing keys and values from 'h0 and 'h1, where values of 'h1 override values of 'h0") '(h0 h1) nil '(hash-manipulation))
72
- (dox-add-doc 'vm-info 'def '("return some information about the state of the current thread") nil nil '(nydp-core))
73
- (dox-add-doc 'pre-compile 'def '("transform parsed forms before the compile and eval stages") '(arg) nil '(nydp-compilation))
74
- (dox-add-doc 'script-run 'def '("announces the start of a plugin load or a script load."
75
- "'event may be one of '(script-start script-end plugin-start plugin-end)"
76
- "'name is the name of the script or plugin concerned") '(event name) nil '(nydp-core))
63
+ (dox-add-doc 'thread-locals 'def '("return a hash bound to the current thread") nil nil '(nydp-core))
64
+ (dox-add-doc 'type-of 'def '("return a symbol for the type of 'arg") '(arg) nil '(nydp-core))
65
+ (dox-add-doc 'eq? 'def '("return 't if 'arg-0 and 'arg-1 are equal, nil otherwise") '(arg-0 arg-1) nil '(nydp-core))
66
+ (dox-add-doc 'cdr-set 'def '("set the cdr of the given 'cell to 'arg, returns 'cell") '(cell arg) nil '(list-manipulation))
67
+ (dox-add-doc 'hash-get 'def '("return the value stored by 'key in 'hsh") '(hsh key) nil '(hash-manipulation))
68
+ (dox-add-doc 'hash-set 'def '("store 'val under 'key in 'hsh, return 'val") '(hsh key val) nil '(hash-manipulation))
69
+ (dox-add-doc 'hash-keys 'def '("return the list of keys in 'hsh") '(hsh) nil '(hash-manipulation))
70
+ (dox-add-doc 'hash-key? 'def '("return 't if 'key is a key of 'hsh") '(hsh key) nil '(hash-manipulation))
71
+ (dox-add-doc 'hash-merge 'def '("return a new hash containing keys and values from 'h0 and 'h1, where values of 'h1 override values of 'h0") '(h0 h1) nil '(hash-manipulation))
72
+ (dox-add-doc 'vm-info 'def '("return some information about the state of the current thread") nil nil '(nydp-core))
73
+ (dox-add-doc 'pre-compile 'def '("transform parsed forms before the compile and eval stages") '(arg) nil '(nydp-compilation))
74
+ (dox-add-doc 'script-run 'def '("announces the start of a plugin load or a script load."
75
+ "'event may be one of '(script-start script-end plugin-start plugin-end)"
76
+ "'name is the name of the script or plugin concerned") '(event name) nil '(nydp-core))
77
77
 
78
- (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))
79
- (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))
80
- (dox-add-doc 'chapter-names 'def '("Get the names of all the chapters nydp knows about") nil nil '(nydp/documentation))
81
- (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))
82
- (dox-add-doc 'chapter-delete 'def '("Remove the named chapter") '(name) nil '(nydp/documentation))
83
- (dox-add-doc 'chapter-find 'def '("Get the named chapter") '(name) nil '(nydp/documentation))
84
- (dox-add-doc 'set-intersection 'def '("return the intersection of the given lists") 'args nil '(list-manipulation))
85
- (dox-add-doc 'set-union 'def '("return the union of the given lists") 'args nil '(list-manipulation))
86
- (dox-add-doc 'dox-add-doc 'def '("Store the provided documentation item."
87
- "'name is the name of the item"
88
- "'what is the type of the item ('def or 'mac or 'thingy ... this is user-definable, not related to 'type-of)"
89
- "'texts is a list of strings to store for this item"
90
- "'args is the args if the item has the notion of args"
91
- "'src the source code of the item if any"
92
- "'chapters the chapters to which the item should be added, if any") '(name what texts args src chapters) nil '(nydp/documentation))
93
- (dox-add-doc 'dox-add-examples 'def '("Add the given examples to the dox for the named item") '(name example-exprs) nil '(nydp/documentation))
78
+ (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))
79
+ (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))
80
+ (dox-add-doc 'chapter-names 'def '("Get the names of all the chapters nydp knows about") nil nil '(nydp/documentation))
81
+ (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))
82
+ (dox-add-doc 'chapter-delete 'def '("Remove the named chapter") '(name) nil '(nydp/documentation))
83
+ (dox-add-doc 'chapter-find 'def '("Get the named chapter") '(name) nil '(nydp/documentation))
84
+ (dox-add-doc 'set-intersection 'def '("return the intersection of the given lists") 'args nil '(list-manipulation))
85
+ (dox-add-doc ''def '("return the intersection of the given lists") 'args nil '(list-manipulation))
86
+ (dox-add-doc 'set-union 'def '("return the union of the given lists") 'args nil '(list-manipulation))
87
+ (dox-add-doc '⋃ 'def '("return the union of the given lists") 'args nil '(list-manipulation))
88
+ (dox-add-doc 'dox-add-doc 'def '("Store the provided documentation item."
89
+ "'name is the name of the item"
90
+ "'what is the type of the item ('def or 'mac or 'thingy ... this is user-definable, not related to 'type-of)"
91
+ "'texts is a list of strings to store for this item"
92
+ "'args is the args if the item has the notion of args"
93
+ "'src the source code of the item if any"
94
+ "'chapters the chapters to which the item should be added, if any") '(name what texts args src chapters) nil '(nydp/documentation))
95
+ (dox-add-doc 'dox-add-examples 'def '("Add the given examples to the dox for the named item") '(name example-exprs) nil '(nydp/documentation))
96
+ (dox-add-doc 'dox-types 'def '("Get the list of types of documented items") nil nil '(nydp/documentation))
97
+ (dox-add-doc 'dox-lookup 'def '("Get the documentation for the given item") '(name) nil '(nydp/documentation))
98
+ (dox-add-doc 'dox-items-by-type 'def '("Get the list of dox items of a given type") '(type) nil '(nydp/documentation))
@@ -127,7 +127,7 @@ scoping, assignment, anonymous functions and more...")
127
127
  ; creates a lexical scope with a unique symbol assigned to
128
128
  ; each variable in 'vars ; executes the 'body.
129
129
  (if (pair? vars)
130
- `(with ,(apply + (map (fn (n) (list n '(uniq ',n))) vars))
130
+ `(with ,(apply + (map (fn (n) `(,n (uniq ',n))) vars))
131
131
  ,@body)
132
132
  `(let ,vars (uniq ',vars) ,@body)))
133
133
 
@@ -226,13 +226,14 @@ scoping, assignment, anonymous functions and more...")
226
226
  (ampersand-expression? name)
227
227
  (ampersand-expression-assignment name value)))
228
228
 
229
- (mac def-assign args
230
- ; override previous definition to allow expressions like (def hsh.foo (arg arg2) ...)
231
- `(= ,@args))
229
+ ; increment the value at 'place by 'inc (default 1)
230
+ (mac ++ (place inc) `(= ,place (+ ,place ,(or inc 1))))
232
231
 
233
- (mac or= (place val)
234
- ; evaluate ,val and assign result to ,place only if ,place is already nil
235
- `(or ,place (= ,place ,val)))
232
+ ; override previous definition to allow expressions like (def hsh.foo (arg arg2) ...)
233
+ (mac def-assign args `(= ,@args))
234
+
235
+ ; evaluate ,val and assign result to ,place only if ,place is already nil
236
+ (mac or= (place val) `(or ,place (= ,place ,val)))
236
237
 
237
238
  (def brace-list-hash-key (k)
238
239
  (if (isa 'symbol k) `(quote ,k)
@@ -259,32 +260,28 @@ scoping, assignment, anonymous functions and more...")
259
260
  (error "Irregular '& syntax: got suffix ~(inspect (cdr rest)) in ~(join-str pfx "&" rest)")
260
261
  (build-ampersand-syntax (car rest))))
261
262
 
262
- (mac brace-list-mono (arg)
263
- ; override 'brace-list-mono in order to provide a useful interpretation for "{ x }" syntax
264
- arg)
263
+ ; override 'brace-list-mono in order to provide a useful interpretation for "{ x }" syntax
264
+ (mac brace-list-mono (arg) arg)
265
265
 
266
- (mac brace-list-empty ()
267
- ; interprets "{ }" as new hash
268
- '(hash))
266
+ ; interprets "{ }" as new hash
267
+ (mac brace-list-empty () '(hash))
269
268
 
269
+ ; parser expands { foo bar } to (brace-list foo bar)
270
270
  (mac brace-list args
271
- ; parser expands { foo bar } to (brace-list foo bar)
272
271
  (if (no args)
273
272
  `(brace-list-empty)
274
273
  (no (cdr args))
275
274
  `(brace-list-mono ,(car args))
276
275
  (brace-list-build-hash args)))
277
276
 
278
- (mac returnlet (var val . body)
279
- ; stores ,val in ,var, executes ,@body, returns ,var. Saves a line of code at the end of
280
- ; 'let. Assumes 'body is going to do something destructive with 'val, but you want 'val before
281
- ; it gets changed. See also 'returning
282
- `(let ,var ,val ,@body ,var))
277
+ ; stores ,val in ,var, executes ,@body, returns ,var. Saves a line of code at the end of
278
+ ; 'let. If 'body assigns to 'var, the assigned value of 'var will be returned. See also 'returning
279
+ (mac returnlet (var val . body) `(let ,var ,val ,@body ,var))
283
280
 
284
- (mac returning (val . body)
285
- ; stores ,val, executes ,@body, and returns ,val. Assumes 'body is going to do something
286
- ; destructive with 'val, but you want 'val before it gets changed. See also 'returnlet
287
- (w/uniq retval `(returnlet ,retval ,val ,@body)))
281
+ ; stores ,val, executes ,@body, and returns ,val. Assumes 'body is going to do something
282
+ ; destructive with 'val, but you want 'val before it gets changed. Note that if 'val is mutated
283
+ ; (eg hash), the mutated value will be returned. See also 'returnlet
284
+ (mac returning (val . body) (w/uniq retval `(returnlet ,retval ,val ,@body)))
288
285
 
289
286
  (mac aif (expr . body)
290
287
  ; like if, except the value of each condition is locally bound to the variable 'it
@@ -331,3 +328,7 @@ scoping, assignment, anonymous functions and more...")
331
328
  ; properly handle any destructuring args if present
332
329
  (fun/approve-arg-names args args)
333
330
  (destructure/build args nil body))
331
+
332
+ ; assign (f place) to place
333
+ (mac zap (f place . args)
334
+ `(= ,place (,f ,place ,@args)))
@@ -52,9 +52,9 @@
52
52
  ; if ,key is not already in ,hsh - evaluate ,val, store the result
53
53
  ; under ,key in ,hsh, and return it
54
54
  (w/uniq (h k v)
55
- `(with (,h ,hsh ,k ,key)
56
- (let ,v (hash-get ,h ,k)
57
- (or ,v (returnlet ,v ,val (hash-set ,h ,k ,v)))))))
55
+ `(with (,h ,hsh ,k ,key)
56
+ (let ,v (hash-get ,h ,k)
57
+ (or ,v (returnlet ,v ,val (hash-set ,h ,k ,v)))))))
58
58
 
59
59
  (mac defmemo (name args . body)
60
60
  ; same as 'def, but caches the result, keyed on args, so for a given set of args the result
@@ -6,35 +6,45 @@
6
6
  (cons (map car args)
7
7
  (apply zip (map cdr args)))))
8
8
 
9
+ ; invokes 'f for each element of 'things, first element processed first
10
+ ; ( "l" in "eachl" = "leftmost first" )
11
+ (def eachl (f things)
12
+ (when things
13
+ (f (car things))
14
+ (eachl f (cdr things))))
15
+
16
+ ; invokes 'f for each element of 'things, last element processed first
17
+ ; ( "r" in "eachr" = "rightmost first" )
9
18
  (def eachr (f things)
10
19
  (when things
11
20
  (eachr f (cdr things))
12
21
  (f (car things))))
13
22
 
14
- (mac push (x things)
15
- ; assign (cons x things) to things
16
- `(= ,things (cons ,x ,things)))
23
+ ; assign (cons x things) to things
24
+ (mac push (x things) `(= ,things (cons ,x ,things)))
17
25
 
18
- (def flatten (things)
19
- ; flatten the given list, recursively
26
+ ; flatten the given list, transforming each leaf-item, recursively
27
+ (def flatmap (f things)
20
28
  (let acc nil
21
29
  (rfnwith flattenize (x things)
22
30
  (if (pair? x)
23
31
  (eachr flattenize x)
24
- (push x acc)))
32
+ (push (f x) acc)))
25
33
  acc))
26
34
 
35
+ ; flatten the given list, recursively
36
+ (def flatten (things) (flatmap x1 things))
37
+
38
+ ; given a list 'al of form '( (k0 v0) (k1 v1) (k2 v2) ... (kn vn) ) and
39
+ ; a 'key, returns the list (kx vx) from 'al where kx is equal to 'key
40
+ ; #attribution: inspiration from arc.arc
27
41
  (def assoc (key al)
28
- ; given a list 'al of form '( (k0 v0) (k1 v1) (k2 v2) ... (kn vn) ) and
29
- ; a 'key, returns the list (kx vx) from 'al where kx is equal to 'key
30
- ; #attribution: inspiration from arc.arc
31
42
  (if (pair? al)
32
43
  (if (caris key (car al))
33
44
  (car al)
34
45
  (assoc key (cdr al)))))
35
46
 
36
- (def alref (key al)
37
- ; given a list 'al of form '( (k0 v0) (k1 v1) (k2 v2) ... (kn vn) ) and
38
- ; a 'key, returns vx from 'al where kx is equal to 'key
39
- ; #attribution: lifted almost directly from arc.arc
40
- (cadr (assoc key al)))
47
+ ; given a list 'al of form '( (k0 v0) (k1 v1) (k2 v2) ... (kn vn) ) and
48
+ ; a 'key, returns vx from 'al where kx is equal to 'key
49
+ ; #attribution: lifted almost directly from arc.arc
50
+ (def alref (key al) (cadr (assoc key al)))
@@ -19,9 +19,8 @@
19
19
 
20
20
  (def quotify (arg) `(quote ,arg))
21
21
 
22
- (defmemo k (arg)
23
- ; return a function that always returns 'arg, similar to K in SKI calculus
24
- (fn nil arg))
22
+ ; return a function that always returns 'arg, similar to K in SKI calculus
23
+ (defmemo k (arg) (fn nil arg))
25
24
 
26
25
  (def len (things)
27
26
  ; return the length of 'things where 'things may be nil, a string, list or hash
@@ -38,25 +37,34 @@
38
37
 
39
38
  (assign dynamics (hash))
40
39
 
41
- (mac dynamic (name)
40
+ (mac dynamic (name initial)
42
41
  ; creates a dynamic variable.
43
- (hash-set dynamics name t)
44
- (let with-mac-name (sym "w/~name")
42
+ (let with-mac-name (sym:+ "w/" name)
45
43
  (w/uniq prev
46
44
  `(do
47
- (mac ,with-mac-name (new-value . body)
48
- (w/uniq result
49
- `(let ,',prev (hash-get (thread-locals) ',',name)
50
- (hash-set (thread-locals) ',',name ,new-value)
51
- (let ,result (do ,@body)
52
- (hash-set (thread-locals) ',',name ,',prev)
53
- ,result))))
54
- (def ,name () (hash-get (thread-locals) ',name))))))
45
+ (hash-set dynamics ',name t)
46
+ (mac ,with-mac-name (new-value . body)
47
+ (w/uniq result
48
+ `(let ,',prev (hash-get (thread-locals) ',',name)
49
+ (hash-set (thread-locals) ',',name ,new-value)
50
+ (returning (do ,@body)
51
+ (hash-set (thread-locals) ',',name ,',prev)))))
52
+ ,(if initial `(hash-set (thread-locals) ',name ,initial))
53
+ (def ,name () (hash-get (thread-locals) ',name))))))
54
+
55
+
56
+ ; overrides 'privately defined earlier in documentation manager
57
+ (dynamic privately)
58
+
59
+ ; suppress documentation of anything defined in 'body
60
+ (mac in-private body
61
+ `(w/privately t ,@body))
55
62
 
56
63
  (mac mapx (things x expr)
57
64
  ; a macro wrapper for 'map
58
65
  ; 'things is a list, 'x is the name of a variable, and 'expr
59
66
  ; is evaluated and collected for each 'x in 'things
67
+ ; usage: (mapx items v (to-string v)) equivalent to (map to-string items)
60
68
  (chapter list-manipulation)
61
69
  `(map (fun (,x) ,expr) ,things))
62
70
 
@@ -1,5 +1,6 @@
1
1
  (chapter-start 'string-manipulation "utilities for manipulating strings")
2
2
 
3
+ ; return a new string with leading and trailing whitespace removed
3
4
  (def string-strip (txt)
4
5
  (string-replace "(^\\s+|\\s+$)" "" txt))
5
6
 
@@ -15,14 +16,17 @@
15
16
  (flatten (map (fn (x) (list txt x))
16
17
  (cdr joinables))))))
17
18
 
18
- (def j items
19
- ; delegate to 'joinstr with an empty join string
20
- ; shortcut for (joinstr "" items)
21
- (joinstr "" items))
19
+ ; stringify join all the things and join them with no separator, like (joinstr "" things)
20
+ (def j things
21
+ (apply + (flatmap to-string things)))
22
22
 
23
+ ; string-interpolation syntax emits this form. Default implementation
24
+ ; is to delegate to 'j , but containing forms may use macros that
25
+ ; override this in order to provide specific interpolation behaviour
26
+ ; (for example, formatting numbers or stripping HTML tags)
23
27
  (def string-pieces pieces
24
- ; string-interpolation syntax emits this form. Default implementation
25
- ; is to delegate to 'j , but containing forms may use macros that
26
- ; override this in order to provide specific interpolation behaviour
27
- ; (for example, formatting numbers or stripping HTML tags)
28
28
  (j pieces))
29
+
30
+ ; return the first 'length chars of string 'str
31
+ (def string-truncate (str length)
32
+ (string-replace "(.{~|length|}).*" "\\1" str))
@@ -147,15 +147,6 @@
147
147
  nil
148
148
  (cons (firstn n list) (_ (nthcdr n list))))))
149
149
 
150
- (def range (start stop)
151
- ; return a list containing the range
152
- ; of elements starting with 'start, up
153
- ; to but not including 'stop
154
- (if (< start stop)
155
- (cons start
156
- (range (+ start 1)
157
- stop))))
158
-
159
150
  (def best (f things)
160
151
  (if (no things)
161
152
  nil
@@ -221,3 +212,6 @@
221
212
  matchers
222
213
  (matchers things)
223
214
  t))
215
+
216
+ ; given an arg 'f, invoke 'f with no args
217
+ (def self-invoke (f) (f))
@@ -90,3 +90,8 @@ Examples for ~name
90
90
  (chapter nydp/documentation)
91
91
  (let ch (chapter-find chapter-name)
92
92
  (= ch.contents (collect (fn (item) (!eq? item.name item-name)) ch.contents))))
93
+
94
+ ; return the first dox item of the given type with the given name
95
+ (def dox-item-by-type (type name)
96
+ (let n (sym name)
97
+ (detect (fn (i) (eq? n i.name)) (dox-items-by-type type))))
@@ -1,3 +1,5 @@
1
+ (chapter-start 'list-manipulation)
2
+
1
3
  (def include? (thing things)
2
4
  ; alias for 'detect
3
5
  ; true if thing is in things, nil otherwise
@@ -15,6 +17,10 @@
15
17
  (map λx(hash-get tmp x)
16
18
  (sort:hash-keys tmp)))))
17
19
 
20
+ ; like 'sort-by, except when 'f returns nil, use 'instead as the sort key instead
21
+ (def safe-sort-by (f instead things)
22
+ (sort-by λi(or (f i) instead) things))
23
+
18
24
  (def mapreduce (fmap freduce things)
19
25
  ; same as (reduce freduce (map fmap things))
20
26
  ; returns the resulting list
@@ -28,9 +34,6 @@
28
34
  ; map 'f over 'things and sum the resulting list
29
35
  (def mapsum (f things) (mapreduce f + things))
30
36
 
31
- ; return values for each key in hash 'h
32
- (def hash-values (h) (map (fn (k) h.,k) (hash-keys h)))
33
-
34
37
  (def seen? ()
35
38
  ; returns a new function f which takes a parameter x
36
39
  ; for each call to f with any value Z for x
@@ -61,18 +64,21 @@
61
64
  (let mi (m2i anchor)
62
65
  (map λm(i2m (+ mi m)) mm))))
63
66
 
64
- ; (auto-hash a b c) same as { a a b b c c }
65
- (mac auto-hash names `(brace-list ,@(flatten:map λn(list n n) names)))
66
-
67
67
  (mac accum (accfn-name . body)
68
- (w/uniq acc
69
- `(let ,acc nil
70
- (let ,accfn-name λa(push a ,acc)
68
+ (w/uniq (things last-cons)
69
+ `(with (,last-cons (cons) ,things nil)
70
+ (= ,things ,last-cons)
71
+ (let ,accfn-name (fn (a) (= ,last-cons (cdr-set ,last-cons (cons a))) a)
71
72
  ,@body
72
- (rev ,acc)))))
73
+ (cdr ,things)))))
73
74
 
74
- ; increment the value at 'place by 'inc (default 1)
75
- (mac ++ (place inc) `(= ,place (+ ,place ,(or inc 1))))
75
+ ; return a list containing the range of elements starting with 'start,
76
+ ; up to but not including 'stop
77
+ (def range (start stop)
78
+ (accum acc
79
+ (rfnwith r (n start)
80
+ (if (< n stop)
81
+ (r (+ (acc n) 1))))))
76
82
 
77
83
  ; return a function that returns 'start on first invocation,
78
84
  ; and 'start + n * 'incr for each nth invocation
@@ -145,3 +151,12 @@
145
151
  (fill-buckets others max buckets size-f key))))
146
152
  (fill-buckets items max (bucket/new buckets) size-f key))
147
153
  buckets))
154
+
155
+ ; return the list except for the last element
156
+ (def all-but-last (things)
157
+ (accum acc
158
+ ((afn (xs)
159
+ (when (cdr xs)
160
+ (acc (car xs))
161
+ (self (cdr xs))))
162
+ things)))