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.
- checksums.yaml +4 -4
- data/README.md +44 -0
- data/lib/lisp/core-015-documentation.nydp +12 -7
- data/lib/lisp/core-017-builtin-dox.nydp +13 -12
- data/lib/lisp/core-030-syntax.nydp +24 -16
- data/lib/lisp/core-037-list-utils.nydp +0 -11
- data/lib/lisp/core-040-utils.nydp +11 -0
- data/lib/lisp/core-041-string-utils.nydp +1 -1
- data/lib/lisp/core-043-list-utils.nydp +6 -6
- data/lib/lisp/core-080-pretty-print.nydp +5 -0
- data/lib/lisp/core-090-hook.nydp +19 -7
- data/lib/lisp/core-120-settings.nydp +2 -2
- data/lib/lisp/core-130-validations.nydp +51 -0
- data/lib/lisp/core-900-benchmarking.nydp +59 -1
- data/lib/lisp/tests/multi-assign-examples.nydp +6 -0
- data/lib/lisp/tests/settings-examples.nydp +16 -0
- data/lib/lisp/tests/string-tests.nydp +4 -1
- data/lib/lisp/tests/to-integer-examples.nydp +16 -0
- data/lib/lisp/tests/validation-examples.nydp +15 -0
- data/lib/nydp.rb +4 -0
- data/lib/nydp/builtin/date.rb +6 -1
- data/lib/nydp/builtin/inspect.rb +1 -1
- data/lib/nydp/builtin/plus.rb +10 -2
- data/lib/nydp/builtin/random_string.rb +2 -2
- data/lib/nydp/builtin/ruby_wrap.rb +8 -5
- data/lib/nydp/builtin/string_match.rb +2 -2
- data/lib/nydp/builtin/string_pad_left.rb +1 -1
- data/lib/nydp/builtin/string_pad_right.rb +1 -1
- data/lib/nydp/builtin/string_replace.rb +1 -1
- data/lib/nydp/builtin/string_split.rb +1 -2
- data/lib/nydp/builtin/to_integer.rb +23 -0
- data/lib/nydp/builtin/to_string.rb +2 -9
- data/lib/nydp/core.rb +4 -2
- data/lib/nydp/core_ext.rb +13 -1
- data/lib/nydp/date.rb +1 -0
- data/lib/nydp/helper.rb +29 -7
- data/lib/nydp/pair.rb +8 -3
- data/lib/nydp/parser.rb +4 -5
- data/lib/nydp/truth.rb +2 -2
- data/lib/nydp/version.rb +1 -1
- data/lib/nydp/vm.rb +7 -0
- data/spec/embedded_spec.rb +12 -12
- data/spec/foreign_hash_spec.rb +2 -2
- data/spec/hash_non_hash_behaviour_spec.rb +7 -7
- data/spec/hash_spec.rb +2 -2
- data/spec/nydp_spec.rb +14 -2
- data/spec/parser_spec.rb +16 -16
- data/spec/rand_spec.rb +3 -3
- data/spec/spec_helper.rb +10 -1
- metadata +7 -2
checksums.yaml
CHANGED
@@ -1,7 +1,7 @@
|
|
1
1
|
---
|
2
2
|
SHA1:
|
3
|
-
metadata.gz:
|
4
|
-
data.tar.gz:
|
3
|
+
metadata.gz: '06876fcb6832d6737b4763607cfe7b4c0ca003c3'
|
4
|
+
data.tar.gz: b45d30570c913940f93585241c1dad9cc71c5872
|
5
5
|
SHA512:
|
6
|
-
metadata.gz:
|
7
|
-
data.tar.gz:
|
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
|
-
|
95
|
-
|
96
|
-
|
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 '
|
39
|
-
"'ensure-f will always be executed, even if there is an error in '
|
40
|
-
"returns the return value of '
|
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
|
47
|
-
(dox-add-doc 'random-string 'def '("return a random string of length 'len (default 10)") '(len)
|
48
|
-
(dox-add-doc 'to-string 'def '("return a human-readable string representation of 'arg") '(arg)
|
49
|
-
(dox-add-doc 'string-length 'def '("return the length of 'arg") '(arg)
|
50
|
-
(dox-add-doc 'string-replace 'def '("replace 'pattern with '
|
51
|
-
(dox-add-doc 'string-split 'def '("split 'str delimited by 'delim") '(str delim)
|
52
|
-
(dox-add-doc 'string-match 'def '("if 'str matches 'pattern, return hash with keys 'match and 'captures ; otherwise nil") '(str pattern)
|
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
|
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")
|
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
|
-
|
236
|
-
|
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 "(
|
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
|
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
|
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
|
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))
|
data/lib/lisp/core-090-hook.nydp
CHANGED
@@ -35,13 +35,25 @@
|
|
35
35
|
(each hook (hooks-for hook-name)
|
36
36
|
(apply hook args))))
|
37
37
|
|
38
|
-
|
39
|
-
|
40
|
-
|
41
|
-
|
42
|
-
|
43
|
-
|
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 "
|
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)
|