nydp 0.4.5 → 0.4.6

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (50) hide show
  1. checksums.yaml +4 -4
  2. data/README.md +44 -0
  3. data/lib/lisp/core-015-documentation.nydp +12 -7
  4. data/lib/lisp/core-017-builtin-dox.nydp +13 -12
  5. data/lib/lisp/core-030-syntax.nydp +24 -16
  6. data/lib/lisp/core-037-list-utils.nydp +0 -11
  7. data/lib/lisp/core-040-utils.nydp +11 -0
  8. data/lib/lisp/core-041-string-utils.nydp +1 -1
  9. data/lib/lisp/core-043-list-utils.nydp +6 -6
  10. data/lib/lisp/core-080-pretty-print.nydp +5 -0
  11. data/lib/lisp/core-090-hook.nydp +19 -7
  12. data/lib/lisp/core-120-settings.nydp +2 -2
  13. data/lib/lisp/core-130-validations.nydp +51 -0
  14. data/lib/lisp/core-900-benchmarking.nydp +59 -1
  15. data/lib/lisp/tests/multi-assign-examples.nydp +6 -0
  16. data/lib/lisp/tests/settings-examples.nydp +16 -0
  17. data/lib/lisp/tests/string-tests.nydp +4 -1
  18. data/lib/lisp/tests/to-integer-examples.nydp +16 -0
  19. data/lib/lisp/tests/validation-examples.nydp +15 -0
  20. data/lib/nydp.rb +4 -0
  21. data/lib/nydp/builtin/date.rb +6 -1
  22. data/lib/nydp/builtin/inspect.rb +1 -1
  23. data/lib/nydp/builtin/plus.rb +10 -2
  24. data/lib/nydp/builtin/random_string.rb +2 -2
  25. data/lib/nydp/builtin/ruby_wrap.rb +8 -5
  26. data/lib/nydp/builtin/string_match.rb +2 -2
  27. data/lib/nydp/builtin/string_pad_left.rb +1 -1
  28. data/lib/nydp/builtin/string_pad_right.rb +1 -1
  29. data/lib/nydp/builtin/string_replace.rb +1 -1
  30. data/lib/nydp/builtin/string_split.rb +1 -2
  31. data/lib/nydp/builtin/to_integer.rb +23 -0
  32. data/lib/nydp/builtin/to_string.rb +2 -9
  33. data/lib/nydp/core.rb +4 -2
  34. data/lib/nydp/core_ext.rb +13 -1
  35. data/lib/nydp/date.rb +1 -0
  36. data/lib/nydp/helper.rb +29 -7
  37. data/lib/nydp/pair.rb +8 -3
  38. data/lib/nydp/parser.rb +4 -5
  39. data/lib/nydp/truth.rb +2 -2
  40. data/lib/nydp/version.rb +1 -1
  41. data/lib/nydp/vm.rb +7 -0
  42. data/spec/embedded_spec.rb +12 -12
  43. data/spec/foreign_hash_spec.rb +2 -2
  44. data/spec/hash_non_hash_behaviour_spec.rb +7 -7
  45. data/spec/hash_spec.rb +2 -2
  46. data/spec/nydp_spec.rb +14 -2
  47. data/spec/parser_spec.rb +16 -16
  48. data/spec/rand_spec.rb +3 -3
  49. data/spec/spec_helper.rb +10 -1
  50. metadata +7 -2
checksums.yaml CHANGED
@@ -1,7 +1,7 @@
1
1
  ---
2
2
  SHA1:
3
- metadata.gz: 1360fe08561240c0e05c70a69629b42b38078275
4
- data.tar.gz: 70c0dfe6df1a0b2bf24ef39aca70646d7f8c3cac
3
+ metadata.gz: '06876fcb6832d6737b4763607cfe7b4c0ca003c3'
4
+ data.tar.gz: b45d30570c913940f93585241c1dad9cc71c5872
5
5
  SHA512:
6
- metadata.gz: 5db0e86f33a7ebe4afc33478d1fe6a2da5a6a8d07b85d66532cd155adb9b8b567d6edbe90f3ab0b437f59a03ec2047ca51778c2d0923355131b8e9b718260c83
7
- data.tar.gz: 0d4491009c98301ab947668fd396bf7f3544b229de8d1820065073f0bfb01e7db509cba3f749f07f6575b791222d1aa7870c3d0e86d96dce4e95a1ddac8cba00
6
+ metadata.gz: d874e4fbbba55a5995f699451bbf305fe7667f4058cdab2e713fe64900bc96ed285fe5ae8d0c460c73001f0a44fb22699c634c2017a723e9c79d818779d38b7e
7
+ data.tar.gz: 5d5f3aeb4e7c0e65af1024990fdfa5f73a8f4657a06dfd11aaeec172709615a3879f0bdff0efd19475a223add58ee1dd6379951548979eda5b80f30861967e61
data/README.md CHANGED
@@ -55,6 +55,22 @@ answer = Nydp.apply_function ns, :question, :life, ["The Universe", and_also(eve
55
55
 
56
56
  You can maintain multiple `ns` instances without mutual interference. In other words, assigning global variables while one `ns` is in scope will not affect the values of variables in any other `ns` (unless you've specifically arranged it to be so by duplicating namespaces or some such sorcery).
57
57
 
58
+
59
+ #### Facing the Truth
60
+
61
+ In conditional statements, nil is false, anything else is true
62
+
63
+ ```lisp
64
+ (if) ;; same as (if nil)
65
+ (if a) ;; same as a
66
+ (if a b) ;; same as (if a b nil)
67
+ (if a b c) ;; if a is nil, return c, otherwise return b
68
+ (if a b c d) ;; same as (if a b (if c d))
69
+ (if a b c d e) ;; same as (if a b (if c d e))
70
+
71
+ ;; and so on
72
+ ```
73
+
58
74
  ## Different from Arc :
59
75
 
60
76
  #### 1. Macro-expansion runs in lisp
@@ -151,8 +167,36 @@ nydp > (map &lastname german-composers) ; ampersand-syntax creates a function
151
167
 
152
168
  As with all other syntax, you can of course override the `ampersand-syntax` macro to handle your special needs.
153
169
 
170
+ You can combine special syntaxes ("%td" comes from nydp-html gem)
171
+
172
+ ```lisp
173
+
174
+ nydp > (map %td:&lastname german-composers)
175
+
176
+ "<td>Bach</td><td>Beethoven</td><td>Wagner</td><td>Mozart</td>"
177
+
178
+ ```
179
+
180
+ So, @%td@ expands to @(percent-syntax || td)@, @&lastname@ to @(ampersand-syntax || lastname)@, and the whole @%td:&lastname@
181
+ to @(colon-syntax (percent-syntax || td) (ampersand-syntax || lastname))@. Luckily for you, there's a fine @colon-syntax@ macro
182
+ that knows how to build a function out of these bits and pieces.
183
+
184
+
154
185
  Look for `SYMBOL_OPERATORS` in [parser.rb](lib/nydp/parser.rb) to see which syntax is recognised and in which order. The order of these definitions defines special-syntax-operator precedence.
155
186
 
187
+ Any character that is not special syntax will be recognised as part of a symbol. At time of writing, this includes the plus sign, hyphen, and slash.
188
+
189
+ ```lisp
190
+
191
+ ;; nonsense code illustrating the use of certain
192
+ ;; characters as function and variable names
193
+ (def //-+ (x y z)
194
+ (let -*- (x y)
195
+ (if z (//-+ x y -*-) -*-)))
196
+
197
+ ```
198
+
199
+
156
200
  #### 3. Special list syntax
157
201
 
158
202
  The parser detects alternative list delimiters
@@ -83,17 +83,20 @@
83
83
  (def dox-new (item)
84
84
  (hash-cons dox (hash-get item 'name) item)
85
85
  (hash-cons types (hash-get item 'what) item)
86
- (dox-add-to-chapters item (hash-get item 'what) (hash-get item 'chapters)))
86
+ (dox-add-to-chapters item (hash-get item 'what) (hash-get item 'chapters) (hash)))
87
87
 
88
88
  (def dox-add-doc (name what texts args src chapters more)
89
89
  (cond (no (privately))
90
90
  (dox-new (dox-build (if more more (hash)) name what texts args src chapters))))
91
91
 
92
- (def dox-add-to-chapters (item type chapters)
92
+ (def dox-add-to-chapters (item type chapters already)
93
93
  (cond chapters
94
- (do (chapter-add-item item (car chapters))
95
- (hash-cons types-chapters (inspect (cons type (car chapters))) item)
96
- (dox-add-to-chapters item type (cdr chapters)))
94
+ (cond (no (hash-get already (car chapters)))
95
+ (do (hash-set already (car chapters) t)
96
+ (chapter-add-item item (car chapters))
97
+ (hash-cons types-chapters (inspect (cons type (car chapters))) item)
98
+ (dox-add-to-chapters item type (cdr chapters) already))
99
+ item)
97
100
  item))
98
101
 
99
102
  (def dox-add-examples (name example-exprs)
@@ -171,10 +174,12 @@
171
174
  (hash-set hsh 'chapter nil)
172
175
  hsh)
173
176
 
177
+ (def dox-build-def-name (name) name)
178
+
174
179
  ;; used internally by 'mac
175
180
  (def define-mac-expr (name args body-forms)
176
181
  `(do (hash-set macs ',name (fun ,args ,@(hash-get body-forms nil)))
177
- (dox-add-doc ',name
182
+ (dox-add-doc ',(dox-build-def-name name)
178
183
  'mac
179
184
  ',(+ (fetch-and-clear-comments) (map car (hash-get body-forms 'comment)))
180
185
  ',args
@@ -204,7 +209,7 @@
204
209
  ;; used internally by 'def
205
210
  (def define-def-expr (name args body-forms)
206
211
  `(do (def-assign ,name (fun ,args ,@(filter-comments (hash-get body-forms nil))))
207
- (dox-add-doc ',name
212
+ (dox-add-doc ',(dox-build-def-name name)
208
213
  'def
209
214
  ',(+ (fetch-and-clear-comments) (map car (hash-get body-forms 'comment)))
210
215
  ',args
@@ -1,6 +1,7 @@
1
1
  (dox-add-doc 'cons 'def '("with args a and b, returns a new cons cell, (a . b)") '(a b) nil '(list-manipulation))
2
2
  (dox-add-doc 'car 'def '("with args a, where a is a cons cell (x . y), return x." "Commonly used to get the first element of a list") '(a) nil '(list-manipulation))
3
3
  (dox-add-doc 'cdr 'def '("with args a, where a is a cons cell (x . y), return y." "Commonly used to get contents of a list, excluding the first element") '(a) nil '(list-manipulation))
4
+ (dox-add-doc 'log 'def '("write arg to Nydp.logger ; be sure to assign Nydp.logger first!") '(arg) nil '(nydp-core))
4
5
  (dox-add-doc '+ 'def '("with rest-args things, return the sum of the elements of things." "Will also increment dates and concatenate strings and lists") 'things nil '(math))
5
6
  (dox-add-doc '- 'def '("return the result of subtracting all other args from the first arg." "(- a b c d) is equivalent to (- a (+ b c d))") 'things nil '(math))
6
7
  (dox-add-doc '* 'def '("with rest-args things, return the product of the elements of things.") 'things nil '(math))
@@ -35,21 +36,21 @@
35
36
  (dox-add-doc 'pair? 'def '("t if arg is a cons cell or (equivalently) the start of a list") '(arg) nil '(nydp-core))
36
37
  (dox-add-doc 'hash? 'def '("t if arg is a hash") '(arg) nil '(nydp-core))
37
38
  (dox-add-doc 'sym? 'def '("t if arg is a symbol, nil otherwise") '(arg) nil '(nydp-core))
38
- (dox-add-doc 'ensuring 'def '("execute 'tricky-f, then 'ensure-f afterwards"
39
- "'ensure-f will always be executed, even if there is an error in 'tricky-f"
40
- "returns the return value of 'tricky-f") '(ensure-f tricky-f) nil '(flow-control))
39
+ (dox-add-doc 'ensuring 'def '("execute 'try-f, then 'ensure-f afterwards"
40
+ "'ensure-f will always be executed, even if there is an error in 'try-f"
41
+ "returns the return value of 'try-f. Similar to try/finally in java, or begin/ensure in ruby.") '(ensure-f try-f) nil '(flow-control))
41
42
  (dox-add-doc 'inspect 'def '("return a string representing 'arg, potentially (but not always) in a way that can be parsed back in to get the original object") '(arg) nil '(nydp-core))
42
43
  (dox-add-doc 'comment 'def '("does nothing at all." "Intercepted inside 'def and 'mac and used for documentation") '(arg) nil '(nydp-core))
43
44
  (dox-add-doc 'parse-in-string 'def '("parse the given string assuming a string-open delimiter has already been encountered") '(str) nil '(nydp-core))
44
45
  (dox-add-doc 'rand 'def '("return a random number ; with no args, between 0 and 1"
45
46
  "with 1 arg, an integer less than arg"
46
- "with two args, an integer >= arg 0 and < arg 1") 'args nil '(math))
47
- (dox-add-doc 'random-string 'def '("return a random string of length 'len (default 10)") '(len) nil '(string-manipulation))
48
- (dox-add-doc 'to-string 'def '("return a human-readable string representation of 'arg") '(arg) nil '(string-manipulation))
49
- (dox-add-doc 'string-length 'def '("return the length of 'arg") '(arg) nil '(string-manipulation))
50
- (dox-add-doc 'string-replace 'def '("replace 'pattern with 'insert in 'str") '(pattern insert str) nil '(string-manipulation))
51
- (dox-add-doc 'string-split 'def '("split 'str delimited by 'delim") '(str delim) nil '(string-manipulation))
52
- (dox-add-doc 'string-match 'def '("if 'str matches 'pattern, return hash with keys 'match and 'captures ; otherwise nil") '(str pattern) nil '(string-manipulation))
47
+ "with two args, an integer >= arg 0 and < arg 1") 'args nil '(math))
48
+ (dox-add-doc 'random-string 'def '("return a random string of length 'len (default 10)") '(len) nil '(string-manipulation))
49
+ (dox-add-doc 'to-string 'def '("return a human-readable string representation of 'arg") '(arg) nil '(string-manipulation))
50
+ (dox-add-doc 'string-length 'def '("return the length of 'arg") '(arg) nil '(string-manipulation))
51
+ (dox-add-doc 'string-replace 'def '("replace 'pattern with 'replacement in 'str") '(pattern replacement str) nil '(string-manipulation))
52
+ (dox-add-doc 'string-split 'def '("split 'str delimited by 'delim") '(str delim) nil '(string-manipulation))
53
+ (dox-add-doc 'string-match 'def '("if 'str matches 'pattern, return hash with keys 'match and 'captures ; otherwise nil") '(str pattern) nil '(string-manipulation))
53
54
  (dox-add-doc 'time 'def '("with no args, return the current time."
54
55
  "With one arg, if 'arg-0 is a number, return the current time plus 'arg-0 seconds."
55
56
  "With one arg, if 'arg-0 is a date, return the time at the beginning of the given date."
@@ -57,9 +58,9 @@
57
58
  "With two args, 'arg-0 must be a time."
58
59
  "If 'arg-1 is a number, return 'arg-0 plus 'arg-1 seconds as a time object."
59
60
  "If 'arg-1 is a time, return the number of seconds between the two (- 'arg-0 arg-1)."
60
- "Otherwise, expect 3, 4, 5, or 6 args, to construct a time from"
61
+ "Otherwise, expect 3 or more args, to construct a time from"
61
62
  "year, month, date, hours, minutes, seconds, milliseconds, reading arguments in that order,"
62
- "where hours, minutes, seconds, and milliseconds are optional") 'args nil '(date-time))
63
+ "where hours, minutes, seconds, and milliseconds are optional") 'args nil '(date-time))
63
64
  (dox-add-doc 'thread-locals 'def '("return a hash bound to the current thread") nil nil '(nydp-core))
64
65
  (dox-add-doc 'type-of 'def '("return a symbol for the type of 'arg") '(arg) nil '(nydp-core))
65
66
  (dox-add-doc 'eq? 'def '("return 't if 'arg-0 and 'arg-1 are equal, nil otherwise") '(arg-0 arg-1) nil '(nydp-core))
@@ -94,6 +94,8 @@ scoping, assignment, anonymous functions and more...")
94
94
  (cons (list (car things) (cadr things))
95
95
  (pairs (cddr things)))))
96
96
 
97
+ ;; like 'let, but creates and assigns multiple local variables.
98
+ ;; for example, "(with (a 1 b 2) (+ a b))" returns 3
97
99
  (mac with (parms . body)
98
100
  `((fun ,(map car (pairs parms))
99
101
  ,@body)
@@ -217,29 +219,23 @@ scoping, assignment, anonymous functions and more...")
217
219
  (and (pair? name)
218
220
  (caris 'ampersand-syntax (car name))))
219
221
 
222
+ ;; (= (&key (expr)) (val))
223
+ ;; (= ((ampersand-syntax key) (expr)) (val))
224
+ ;; 'place is ((ampersand-syntax || key) (expr))
225
+ ;; we need (hash-set (expr) 'key (val))
226
+ ;; however,
227
+ ;; (= (&key.subkey (expr)) (val))
228
+ ;; 'place is ((ampersand-syntax || (dot-syntax key subkey)) (expr))
229
+ ;; we need (hash-set (hash-get (expr) 'key) 'subkey (val))
220
230
  (def ampersand-expression-assignment (place value)
221
- ; (= (&key (expr)) (val))
222
- ; (= ((ampersand-syntax key) (expr)) (val))
223
- ; 'place is ((ampersand-syntax || key) (expr))
224
- ; we need (hash-set (expr) 'key (val))
225
- ; however,
226
- ; (= (&key.subkey (expr)) (val))
227
- ; 'place is ((ampersand-syntax || (dot-syntax key subkey)) (expr))
228
- ; we need (hash-set (hash-get (expr) 'key) 'subkey (val))
229
231
  (with (k (cadr:cdar place)
230
232
  hsh (cadr place))
231
233
  (if (caris 'dot-syntax k)
232
234
  (dot-syntax-assignment (cons hsh (cdr k)) value)
233
235
  `(hash-set ,hsh ',k ,value))))
234
236
 
235
- (mac = (name value)
236
- ; generic assignment which unlike builtin 'assign, knows how to assign
237
- ; to hash keys
238
- ; (= (hash-get (expr) 'key) (val) => (hash-set (expr) 'key (val))
239
- ; (= h.k (val)) => (hash-set h 'k (val))
240
- ; (= h.j.k (val)) => (hash-set (hash-get h 'j) 'k (val))
241
- ; (= (&key (expr)) (val)) => (hash-set (expr) 'key (val))
242
- ; (= (&j.k (expr)) (val)) => (hash-set (hash-get (expr) 'j) 'k (val))
237
+ ;; used internally by '= macro
238
+ (def assign-expr (name value)
243
239
  (if (isa 'symbol name)
244
240
  `(assign ,name ,value)
245
241
  (caris 'dot-syntax name)
@@ -252,6 +248,18 @@ scoping, assignment, anonymous functions and more...")
252
248
  `(hash-set @ ',(caddr name) ,value)
253
249
  (error "unknown assignment to place: ~(inspect name)")))
254
250
 
251
+ ;; generic assignment which unlike builtin 'assign, knows how to assign
252
+ ;; to hash keys
253
+ ;; (= (hash-get (expr) 'key) (val) => (hash-set (expr) 'key (val))
254
+ ;; (= h.k (val)) => (hash-set h 'k (val))
255
+ ;; (= h.j.k (val)) => (hash-set (hash-get h 'j) 'k (val))
256
+ ;; (= (&key (expr)) (val)) => (hash-set (expr) 'key (val))
257
+ ;; (= (&j.k (expr)) (val)) => (hash-set (hash-get (expr) 'j) 'k (val))
258
+ (mac = (name value . more)
259
+ (if more
260
+ `(do ,(assign-expr name value) (= ,@more))
261
+ (assign-expr name value)))
262
+
255
263
  ;; quiet assignment ; like =, but expression returns nil
256
264
  (mac #= (name value)
257
265
  `(do (= ,name ,value) nil))
@@ -60,14 +60,3 @@
60
60
  ; a 'key, returns vx from 'al where kx is equal to 'key
61
61
  ; #attribution: lifted almost directly from arc.arc
62
62
  (def alref (key al) (cadr (assoc key al)))
63
-
64
- ;; returns the first non-empty item in 'args
65
- ;; mac equivalent of (detect present? args)
66
- (mac dp args
67
- (if args
68
- (w/uniq nearg
69
- `(let ,nearg ,(car args)
70
- (if (empty? ,nearg)
71
- (dp ,@(cdr args))
72
- ,nearg)))
73
- nil))
@@ -90,3 +90,14 @@
90
90
  (chapter string-manipulation)
91
91
  (chapter hash-manipulation)
92
92
  (!empty? thing))
93
+
94
+ ;; returns the first non-empty item in 'args
95
+ ;; mac equivalent of (detect present? args)
96
+ (mac dp args
97
+ (if args
98
+ (w/uniq nearg
99
+ `(let ,nearg ,(car args)
100
+ (if (empty? ,nearg)
101
+ (dp ,@(cdr args))
102
+ ,nearg)))
103
+ nil))
@@ -2,7 +2,7 @@
2
2
 
3
3
  ; return a new string with leading and trailing whitespace removed
4
4
  (def string-strip (txt)
5
- (string-replace "(^\\s+|\\s+$)" "" txt))
5
+ (string-replace "(\\A\\s+|\\s+\\z)" "" txt))
6
6
 
7
7
  (def joinstr (txt . things)
8
8
  ; flatten 'things into a single list (ie unnest lists)
@@ -198,8 +198,8 @@
198
198
  list))
199
199
 
200
200
  (def all? (f things)
201
- ; if 'things is a list, true when all items are non-nil
202
- ; if 'things is an atom, true when non-nil
201
+ ; if 'things is a list, true when f(thing) is non-nil for each thing in things
202
+ ; if 'things is an atom, true when f(things) is non-nil
203
203
  (if (pair? things)
204
204
  (and (f:car things)
205
205
  (or (no:cdr things)
@@ -207,8 +207,8 @@
207
207
  (f things)))
208
208
 
209
209
  (def any? (f things)
210
- ; if 'things is a list, true when at least one item is non-nil
211
- ; if 'things is an atom, true when non-nil
210
+ ; if 'things is a list, true when f(thing) is non-nil for at least one thing in things
211
+ ; if 'things is an atom, true when f(thing) is non-nil
212
212
  (if (pair? things)
213
213
  (or (f:car things)
214
214
  (and (cdr things)
@@ -216,8 +216,8 @@
216
216
  (f things)))
217
217
 
218
218
  (def none? (f things)
219
- ; if 'things is a list, true when all items are nil
220
- ; if 'things is an atom, true when nil
219
+ ; if 'things is a list, true when f(thing) is nil for each thing in things
220
+ ; if 'things is an atom, true when f(things) is nil
221
221
  (if (pair? things)
222
222
  (and (no:f:car things)
223
223
  (none? f (cdr things)))
@@ -199,3 +199,8 @@
199
199
  ;; use the pretty-printer to elegantly display the given source code
200
200
  (def dox-show-src (src)
201
201
  (pp src))
202
+
203
+ ;; use 'pp/unsyntax to convert 'def and 'mac names back to a symbol
204
+ ;; so (mac dsl.foo (a1 a2) ...) will be documented as "dsl.foo"
205
+ (def dox-build-def-name (name)
206
+ (pp/unsyntax name))
@@ -35,13 +35,25 @@
35
35
  (each hook (hooks-for hook-name)
36
36
  (apply hook args))))
37
37
 
38
- ; install a hook for a particular kind of event
39
- ;
40
- ; example
41
- ; (on transaction (account amount) (update account total (+ account.total amount)))
42
- ;
43
- ; same as (add-hook 'transaction (fn (account amount) (update account total (+ account.total amount))))
44
- ;
38
+ ;; install a hook for a particular kind of event
39
+ ;;
40
+ ;; example
41
+ ;; (on transaction (account amount) (update account total (+ account.total amount)))
42
+ ;;
43
+ ;; same as (add-hook 'transaction (fn (account amount) (update account total (+ account.total amount))))
44
+ ;;
45
+ ;; if 'body is nil and 'args is a symbol, for example
46
+ ;;
47
+ ;; (on transaction notify)
48
+ ;;
49
+ ;; 'notify must be a predefined function accepting any arguments to the 'transaction event ; the example is equivalent to
50
+ ;;
51
+ ;; (add-hook 'transaction (fn args (apply notify args)))
52
+ ;;
53
+ ;; or more simply
54
+ ;;
55
+ ;; (add-hook 'transaction (fn (account amount) (notify account amount)))
56
+ ;;
45
57
  (mac on (event args . body)
46
58
  (let hookfn (if (isa 'symbol (car body))
47
59
  (car body)
@@ -35,12 +35,12 @@
35
35
  '(def-setting ,name ,initial)
36
36
  '(,(sym "settings/~context"))
37
37
  { setting { default ',initial context ',context name ',name } })
38
- (hash-set initial-settings ',(sym name) ,initial)
38
+ (hash-set initial-settings ',(sym name) ',initial)
39
39
  (set-setting ,(sym name) ,initial))))
40
40
 
41
41
  ; get the value of the given setting. Raises an error if the setting is unknown
42
42
  (def setting (name)
43
43
  (aif (hash-get settings (sym name))
44
- (on-err (error "can't get value of setting ~name")
44
+ (on-err (error "can't get value of setting ~name : stored object is ~(inspect it)")
45
45
  (it name))
46
46
  (error "unknown setting ~(inspect name)")))
@@ -0,0 +1,51 @@
1
+ (chapter-start 'validations "utilities to record and run validation routines")
2
+
3
+ (let validations {}
4
+ (def validate/reset ()
5
+ (= validations {}))
6
+ (def validate/fns (thing context)
7
+ (hash-get validations (list (type-of thing) context)))
8
+ (def validate/fn+ (type context f)
9
+ (hash-cons validations (list type context) f)))
10
+
11
+ ;;
12
+ ;; returns a hash of error-name to list of error messages
13
+ ;;
14
+ ;; An empty return value signifies an error-free 'thing
15
+ ;;
16
+ (def validate (thing context)
17
+ (returnlet msgs {}
18
+ (let msgf λem(hash-cons msgs e m)
19
+ (eachl λv(v thing context msgf)
20
+ (validate/fns thing context)))))
21
+
22
+ ;; declare a validation routine for type 'type in context 'context
23
+ ;;
24
+ ;; 'type must be a symbol
25
+ ;; 'context must be a symbol
26
+ ;; 'body is one or more nydp expressions.
27
+ ;;
28
+ ;; 'body will be embedded in a function with access to the following variables :
29
+ ;;
30
+ ;; * the value of the 'type argument
31
+ ;; * ctx
32
+ ;; * mf
33
+ ;;
34
+ ;; 'mf ("message function") is a function that takes two arguments and is used to store
35
+ ;; the validation error message
36
+ ;; example: (mf "Last name" "Last name must not be empty")
37
+ ;;
38
+ ;; example usage:
39
+ ;;
40
+ ;; (validate/def invoice issue
41
+ ;; (if (no invoice.account)
42
+ ;; (mf "Account" "Account must be a client account"))
43
+ ;; (if (!> invoice.total 0)
44
+ ;; (mf "Amount" "Amount must be greater than zero"))
45
+ ;; (if (any? !&group invoice.invoice-items)
46
+ ;; (mf "Group" "Each line must be assigned to a group")))
47
+ ;;
48
+ ;; if your routine makes no call to 'mf then 'validate will return an empty hash, which should be
49
+ ;; interpreted as signifying that the object in question is error free in the given context.
50
+ (mac validate/def (type context . body)
51
+ `(validate/fn+ ',type ',context (fn (,type ctx mf) ,@body)))
@@ -201,6 +201,63 @@
201
201
 
202
202
 
203
203
 
204
+ ;; ================================================
205
+ ;; Benchmark: string concatenation - 10 runs of 20000 iterations each
206
+ ;; took: 0.702480166 ms, 3.51240083e-05 ms per iteration
207
+ ;; took: 0.71368384 ms, 3.5684192e-05 ms per iteration
208
+ ;; took: 0.722608668 ms, 3.61304334e-05 ms per iteration
209
+ ;; took: 0.716350427 ms, 3.5817521349999995e-05 ms per iteration
210
+ ;; took: 0.72145049 ms, 3.60725245e-05 ms per iteration
211
+ ;; took: 0.745082221 ms, 3.725411105e-05 ms per iteration
212
+ ;; took: 0.722694129 ms, 3.613470645e-05 ms per iteration
213
+ ;; took: 0.71999777 ms, 3.59998885e-05 ms per iteration
214
+ ;; took: 0.727236822 ms, 3.63618411e-05 ms per iteration
215
+ ;; took: 0.73657519 ms, 3.68287595e-05 ms per iteration
216
+ ;; total 7.228159722999999, average 0.7228159722999999 per run
217
+ ;; ================================================
218
+ ;; string concatenation : total 7.228159722999999, average 0.7228159722999999 per run
219
+ ;; (def bm-string-concat ()
220
+ ;; (+
221
+ ;; (+ "this" "that" "another")
222
+ ;; (+ "this" "that" "another")
223
+ ;; (+ "this" "that" "another")
224
+ ;; (+ "this" "that" "another")
225
+ ;; (+ "this" "that" "another")
226
+ ;; (+ "this" "that" "another")
227
+ ;; (+ "this" "that" "another")
228
+ ;; (+ "this" "that" "another")
229
+ ;; (+ "this" "that" "another")
230
+ ;; (+ "this" "that" "another")))
231
+
232
+
233
+ ;; ================================================
234
+ ;; Benchmark: random string - 10 runs of 20000 iterations each
235
+ ;; took: 0.693267608 ms, 3.4663380399999996e-05 ms per iteration
236
+ ;; took: 0.763436112 ms, 3.8171805599999996e-05 ms per iteration
237
+ ;; took: 0.682000681 ms, 3.410003405e-05 ms per iteration
238
+ ;; took: 0.687733846 ms, 3.43866923e-05 ms per iteration
239
+ ;; took: 0.686838878 ms, 3.43419439e-05 ms per iteration
240
+ ;; took: 0.681588034 ms, 3.40794017e-05 ms per iteration
241
+ ;; took: 0.689589352 ms, 3.44794676e-05 ms per iteration
242
+ ;; took: 0.690437907 ms, 3.4521895349999996e-05 ms per iteration
243
+ ;; took: 0.683199842 ms, 3.4159992099999995e-05 ms per iteration
244
+ ;; took: 0.696863126 ms, 3.48431563e-05 ms per iteration
245
+ ;; total 6.954955385999999, average 0.6954955385999999 per run
246
+ ;; ================================================
247
+ ;; random string : total 6.954955385999999, average 0.6954955385999999 per run
248
+
249
+ ;; (def bm-random-string ()
250
+ ;; (list (random-string)
251
+ ;; (random-string)
252
+ ;; (random-string)
253
+ ;; (random-string)
254
+ ;; (random-string)
255
+ ;; (random-string)
256
+ ;; (random-string)
257
+ ;; (random-string)
258
+ ;; (random-string)
259
+ ;; (random-string)))
260
+
204
261
  (def bm-repeat (f n)
205
262
  ; used in benchmarking
206
263
  (for b 1 n (f)))
@@ -223,7 +280,8 @@
223
280
 
224
281
  (def rbs (name)
225
282
  (let summary nil
226
- (push (bm "no-closures " bm-no-closures 10 20000) summary)
283
+ ;; (push (bm "random string " bm-random-string 10 20000) summary)
284
+ ;; (push (bm "string concatenation " bm-string-concat 10 20000) summary)
227
285
  ;; (push (bm "type-of " bm-type-of 10 20000) summary)
228
286
  ;; (push (bm "accum " bm-acc 10 500) summary)
229
287
  ;; (push (bm "accum " bm-facc 10 500) summary)