nydp 0.4.5 → 0.4.6
Sign up to get free protection for your applications and to get access to all the features.
- 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)
|