nydp 0.5.0 → 0.6.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/.gitignore +1 -0
- data/README.md +77 -56
- data/lib/lisp/core-000.nydp +1 -1
- data/lib/lisp/core-010-precompile.nydp +49 -29
- data/lib/lisp/core-012-utils.nydp +12 -8
- data/lib/lisp/core-015-documentation.nydp +41 -15
- data/lib/lisp/core-017-builtin-dox.nydp +621 -100
- data/lib/lisp/core-020-utils.nydp +33 -6
- data/lib/lisp/core-025-warnings.nydp +1 -1
- data/lib/lisp/core-030-syntax.nydp +64 -48
- data/lib/lisp/core-035-flow-control.nydp +20 -28
- data/lib/lisp/core-037-list-utils.nydp +84 -21
- data/lib/lisp/core-040-utils.nydp +8 -5
- data/lib/lisp/core-041-string-utils.nydp +17 -11
- data/lib/lisp/core-043-list-utils.nydp +140 -77
- data/lib/lisp/core-045-dox-utils.nydp +1 -0
- data/lib/lisp/core-050-test-runner.nydp +8 -12
- data/lib/lisp/core-070-prefix-list.nydp +19 -15
- data/lib/lisp/core-080-pretty-print.nydp +13 -5
- data/lib/lisp/core-090-hook.nydp +11 -11
- data/lib/lisp/core-100-utils.nydp +51 -66
- data/lib/lisp/core-110-hash-utils.nydp +34 -7
- data/lib/lisp/core-120-settings.nydp +14 -9
- data/lib/lisp/core-130-validations.nydp +28 -13
- data/lib/lisp/core-900-benchmarking.nydp +420 -47
- data/lib/lisp/tests/000-empty-args-examples.nydp +5 -0
- data/lib/lisp/tests/andify-examples.nydp +1 -1
- data/lib/lisp/tests/auto-hash-examples.nydp +6 -1
- data/lib/lisp/tests/best-examples.nydp +1 -1
- data/lib/lisp/tests/boot-tests.nydp +1 -1
- data/lib/lisp/tests/date-examples.nydp +129 -102
- data/lib/lisp/tests/destructuring-examples.nydp +1 -1
- data/lib/lisp/tests/dox-tests.nydp +2 -2
- data/lib/lisp/tests/hash-examples.nydp +58 -33
- data/lib/lisp/tests/list-tests.nydp +137 -1
- data/lib/lisp/tests/pretty-print-tests.nydp +12 -0
- data/lib/lisp/tests/rotate-2d-array-examples.nydp +26 -0
- data/lib/lisp/tests/sort-examples.nydp +5 -5
- data/lib/lisp/tests/string-tests.nydp +30 -5
- data/lib/lisp/tests/syntax-tests.nydp +10 -2
- data/lib/lisp/tests/time-examples.nydp +8 -1
- data/lib/lisp/tests/unparse-tests.nydp +13 -7
- data/lib/nydp/assignment.rb +15 -28
- data/lib/nydp/builtin/abs.rb +4 -3
- data/lib/nydp/builtin/apply.rb +8 -10
- data/lib/nydp/builtin/cdr_set.rb +1 -1
- data/lib/nydp/builtin/comment.rb +1 -3
- data/lib/nydp/builtin/date.rb +11 -28
- data/lib/nydp/builtin/divide.rb +3 -10
- data/lib/nydp/builtin/ensuring.rb +6 -21
- data/lib/nydp/builtin/error.rb +2 -4
- data/lib/nydp/builtin/eval.rb +9 -4
- data/lib/nydp/builtin/greater_than.rb +7 -8
- data/lib/nydp/builtin/handle_error.rb +10 -34
- data/lib/nydp/builtin/hash.rb +24 -45
- data/lib/nydp/builtin/inspect.rb +1 -3
- data/lib/nydp/builtin/is_equal.rb +4 -7
- data/lib/nydp/builtin/less_than.rb +6 -7
- data/lib/nydp/builtin/log.rb +7 -0
- data/lib/nydp/builtin/math_ceiling.rb +1 -3
- data/lib/nydp/builtin/math_floor.rb +1 -3
- data/lib/nydp/builtin/math_power.rb +1 -3
- data/lib/nydp/builtin/math_round.rb +2 -2
- data/lib/nydp/builtin/minus.rb +7 -14
- data/lib/nydp/builtin/parse.rb +5 -5
- data/lib/nydp/builtin/parse_in_string.rb +5 -7
- data/lib/nydp/builtin/plus.rb +14 -31
- data/lib/nydp/builtin/pre_compile.rb +1 -3
- data/lib/nydp/builtin/puts.rb +4 -8
- data/lib/nydp/builtin/quit.rb +1 -1
- data/lib/nydp/builtin/rand.rb +6 -11
- data/lib/nydp/builtin/random_string.rb +2 -4
- data/lib/nydp/builtin/rng.rb +25 -0
- data/lib/nydp/builtin/ruby_wrap.rb +27 -14
- data/lib/nydp/builtin/script_run.rb +1 -3
- data/lib/nydp/builtin/set_intersection.rb +3 -4
- data/lib/nydp/builtin/set_union.rb +3 -4
- data/lib/nydp/builtin/sort.rb +2 -7
- data/lib/nydp/builtin/string_match.rb +5 -13
- data/lib/nydp/builtin/string_replace.rb +2 -7
- data/lib/nydp/builtin/string_split.rb +3 -8
- data/lib/nydp/builtin/sym.rb +2 -9
- data/lib/nydp/builtin/thread_locals.rb +2 -2
- data/lib/nydp/builtin/time.rb +38 -44
- data/lib/nydp/builtin/times.rb +6 -15
- data/lib/nydp/builtin/to_integer.rb +8 -14
- data/lib/nydp/builtin/to_string.rb +2 -13
- data/lib/nydp/builtin/type_of.rb +10 -16
- data/lib/nydp/builtin/vm_info.rb +2 -10
- data/lib/nydp/builtin.rb +15 -37
- data/lib/nydp/compiler.rb +29 -19
- data/lib/nydp/cond.rb +95 -88
- data/lib/nydp/context_symbol.rb +11 -9
- data/lib/nydp/core.rb +74 -73
- data/lib/nydp/core_ext.rb +88 -24
- data/lib/nydp/date.rb +22 -19
- data/lib/nydp/error.rb +2 -3
- data/lib/nydp/function_invocation.rb +76 -289
- data/lib/nydp/helper.rb +18 -9
- data/lib/nydp/interpreted_function.rb +159 -25
- data/lib/nydp/lexical_context.rb +9 -8
- data/lib/nydp/lexical_context_builder.rb +1 -1
- data/lib/nydp/literal.rb +3 -7
- data/lib/nydp/loop.rb +72 -0
- data/lib/nydp/namespace.rb +52 -0
- data/lib/nydp/pair.rb +146 -50
- data/lib/nydp/parser.rb +9 -11
- data/lib/nydp/plugin.rb +88 -19
- data/lib/nydp/runner.rb +141 -23
- data/lib/nydp/symbol.rb +16 -26
- data/lib/nydp/symbol_lookup.rb +3 -2
- data/lib/nydp/tokeniser.rb +1 -1
- data/lib/nydp/truth.rb +2 -37
- data/lib/nydp/version.rb +1 -1
- data/lib/nydp.rb +33 -44
- data/nydp.gemspec +2 -1
- data/spec/date_spec.rb +26 -32
- data/spec/embedded_spec.rb +22 -22
- data/spec/error_spec.rb +12 -16
- data/spec/foreign_hash_spec.rb +21 -36
- data/spec/hash_non_hash_behaviour_spec.rb +12 -29
- data/spec/hash_spec.rb +36 -49
- data/spec/literal_spec.rb +6 -6
- data/spec/nydp_spec.rb +14 -14
- data/spec/pair_spec.rb +8 -8
- data/spec/parser_spec.rb +41 -37
- data/spec/rand_spec.rb +1 -4
- data/spec/spec_helper.rb +3 -3
- data/spec/string_atom_spec.rb +15 -16
- data/spec/symbol_spec.rb +27 -52
- data/spec/thread_local_spec.rb +23 -8
- data/spec/time_spec.rb +4 -10
- data/spec/tokeniser_spec.rb +10 -10
- metadata +25 -13
- data/lib/nydp/builtin/modulo.rb +0 -11
- data/lib/nydp/builtin/regexp.rb +0 -7
- data/lib/nydp/builtin/sqrt.rb +0 -7
- data/lib/nydp/builtin/string_pad_left.rb +0 -7
- data/lib/nydp/builtin/string_pad_right.rb +0 -7
- data/lib/nydp/hash.rb +0 -9
- data/lib/nydp/image_store.rb +0 -21
- data/lib/nydp/vm.rb +0 -129
@@ -1,32 +1,59 @@
|
|
1
1
|
(chapter-start 'list-manipulation)
|
2
2
|
|
3
|
-
|
4
|
-
|
5
|
-
|
6
|
-
|
3
|
+
;; each call to the name 'accfn-name with an arg will append the arg to the end of a list.
|
4
|
+
;; This form returns the resulting list.
|
5
|
+
;; Example (collect first names from a list of people)
|
6
|
+
;;
|
7
|
+
;; (accum a (each person people (a person.firstname)))
|
8
|
+
;;
|
9
|
+
;; will return (Alice Bob Carol Declan Eliza Fionn)
|
10
|
+
;;
|
11
|
+
(mac accum (accfn-name . body)
|
12
|
+
(w/uniq (things last-cons)
|
13
|
+
`(with (,last-cons (cons)
|
14
|
+
,things ,last-cons
|
15
|
+
,accfn-name (fn (a)
|
16
|
+
(= ,last-cons (cdr-set ,last-cons (cons a)))
|
17
|
+
a)
|
18
|
+
accum-end (fn (a)
|
19
|
+
(= ,last-cons (cdr-set ,last-cons a))
|
20
|
+
a))
|
21
|
+
,@body
|
22
|
+
(cdr ,things))))
|
7
23
|
|
24
|
+
(def list-length (things)
|
25
|
+
(let cc 0
|
26
|
+
(loop (pair? things)
|
27
|
+
(do
|
28
|
+
(++ cc)
|
29
|
+
(= things (cdr things))))
|
30
|
+
(if things (+ cc 1) cc)))
|
31
|
+
|
32
|
+
;; slice 'things into a list of lists each with maximum 'slice-size items
|
8
33
|
(def list-slices (things slice-size)
|
9
|
-
|
10
|
-
|
11
|
-
|
12
|
-
|
13
|
-
|
14
|
-
|
15
|
-
|
16
|
-
|
17
|
-
|
18
|
-
|
34
|
+
(chapter pagination)
|
35
|
+
(if things
|
36
|
+
(if (> slice-size (len things))
|
37
|
+
(list things)
|
38
|
+
(cons (firstn slice-size things)
|
39
|
+
(list-slices (nthcdr slice-size things)
|
40
|
+
slice-size)))
|
41
|
+
nil))
|
42
|
+
|
43
|
+
;; return a new list with 'inbetween in between every element of 'things
|
19
44
|
(def intersperse (inbetween things)
|
20
|
-
|
21
|
-
|
22
|
-
|
23
|
-
|
24
|
-
|
45
|
+
(accum i
|
46
|
+
(while (pair? things)
|
47
|
+
(i (car things))
|
48
|
+
(if (cdr things)
|
49
|
+
(i inbetween))
|
50
|
+
(= things (cdr things)))
|
51
|
+
(if things (accum-end things))))
|
25
52
|
|
26
53
|
;; expects 'things a list of lists, joins the lists
|
27
|
-
;; returns (a b X c d X e f)
|
28
54
|
;; placing 'inbetween in between each list.
|
29
55
|
;; For example (intersperse-splicing 'X '((a b) (c d) (e f)))
|
56
|
+
;; returns (a b X c d X e f)
|
30
57
|
(def intersperse-splicing (inbetween things)
|
31
58
|
(apply joinlists (intersperse (list inbetween) things)))
|
32
59
|
|
@@ -34,15 +61,19 @@
|
|
34
61
|
;; otherwise, return 'things if (f things) is non-nil
|
35
62
|
;; otherwise, nil
|
36
63
|
;; note that this preserves improper lists and may return only the lastcdr if all else fails...
|
37
|
-
(def collect (f
|
38
|
-
(
|
39
|
-
|
40
|
-
|
41
|
-
(
|
42
|
-
|
43
|
-
|
44
|
-
(
|
45
|
-
|
64
|
+
(def collect-helper (f things res)
|
65
|
+
(loop (pair? things)
|
66
|
+
(do
|
67
|
+
(if (f (car things))
|
68
|
+
(= res (cdr-set res (cons (car things)))))
|
69
|
+
(= things (cdr things))))
|
70
|
+
(if (and things (f things))
|
71
|
+
(= res (cdr-set res things))))
|
72
|
+
|
73
|
+
(def collect (f things)
|
74
|
+
(let res (cons)
|
75
|
+
(collect-helper f things res)
|
76
|
+
(cdr res)))
|
46
77
|
|
47
78
|
(assign select collect)
|
48
79
|
|
@@ -57,28 +88,46 @@
|
|
57
88
|
(def reject (f things)
|
58
89
|
(collect !f things))
|
59
90
|
|
60
|
-
(def each/build-expression (var things body othervars otherparams)
|
61
|
-
(w/uniq (xs c)
|
62
|
-
`(rfnwith ,c (,xs ,things ,@othervars)
|
63
|
-
(if (pair? ,xs)
|
64
|
-
(let ,var (car ,xs)
|
65
|
-
,@body
|
66
|
-
(,c (cdr ,xs) ,@otherparams))))))
|
67
|
-
|
68
91
|
;; repeatedly assigns an element of 'things to 'var,
|
69
92
|
;; and executes 'body each time
|
70
93
|
(mac each (var things . body)
|
71
|
-
(
|
72
|
-
|
94
|
+
(w/uniq xs
|
95
|
+
`(let ,xs ,things
|
96
|
+
(loop ,xs
|
97
|
+
(let ,var (car ,xs)
|
98
|
+
,@body
|
99
|
+
(= ,xs (cdr ,xs)))))))
|
100
|
+
|
101
|
+
;; repeatedly assigns an element of 'things to 'var, increments 'ivar,
|
102
|
+
;; and executes 'body each time
|
73
103
|
(mac each-with-index (ivar var things . body)
|
74
|
-
(
|
104
|
+
(w/uniq xs
|
105
|
+
`(with (,xs ,things ,ivar 0)
|
106
|
+
(loop ,xs
|
107
|
+
(let ,var (car ,xs)
|
108
|
+
,@body
|
109
|
+
(++ ,ivar)
|
110
|
+
(= ,xs (cdr ,xs)))))))
|
111
|
+
|
112
|
+
|
113
|
+
;; used internally by 'reduce
|
114
|
+
(def reduce-helper (f a things)
|
115
|
+
(loop (pair? things)
|
116
|
+
(= a (f a (car things))
|
117
|
+
things (cdr things)))
|
118
|
+
(if things
|
119
|
+
(= a (f a things)))
|
120
|
+
a)
|
75
121
|
|
122
|
+
;; applies f to each element of 'things and the result of f, returning the result
|
123
|
+
;;
|
124
|
+
;; for example, (reduce + '(1 2 3)) returns 6
|
125
|
+
;;
|
76
126
|
(def reduce (f things)
|
77
|
-
(
|
78
|
-
|
79
|
-
|
80
|
-
|
81
|
-
acc)))
|
127
|
+
(if (pair? things)
|
128
|
+
(reduce-helper f (car things) (cdr things))
|
129
|
+
things
|
130
|
+
(f things)))
|
82
131
|
|
83
132
|
;; t if this is a proper list (last cdr is nil)
|
84
133
|
;; nil otherwise (last cdr is neither cons nor nil)
|
@@ -94,17 +143,11 @@
|
|
94
143
|
(firstn (- n 1)
|
95
144
|
(cdr things)))))
|
96
145
|
|
97
|
-
|
98
|
-
|
99
|
-
|
100
|
-
|
101
|
-
things))
|
102
|
-
|
146
|
+
;; return a new list which is the concatenation of all the given lists
|
147
|
+
;; 'things is a list
|
148
|
+
;; 'more-thingses is a list of lists
|
149
|
+
;; call like this: (joinlists '(a b c) '(x y z) '(1 2 3))
|
103
150
|
(def joinlists (things . more-thingses)
|
104
|
-
; return a new list which is the concatenation of all the given lists
|
105
|
-
; 'things is a list
|
106
|
-
; 'more-thingses is a list of lists
|
107
|
-
; call like this: (joinlists '(a b c) '(x y z) '(1 2 3))
|
108
151
|
(if things
|
109
152
|
(cons (car things)
|
110
153
|
(apply joinlists
|
@@ -113,28 +156,28 @@
|
|
113
156
|
more-thingses
|
114
157
|
(apply joinlists more-thingses)))
|
115
158
|
|
159
|
+
(def detect-helper (f things found)
|
160
|
+
(loop (and (no found) (pair? things))
|
161
|
+
(let it (car things)
|
162
|
+
(= found (and (f it) (or it t))
|
163
|
+
things (cdr things))))
|
164
|
+
(if (and (no found) things)
|
165
|
+
(= found (and (f things) things)))
|
166
|
+
found)
|
167
|
+
|
168
|
+
;; if 'f is a function,
|
169
|
+
;; if 'things is a list, return the first item in the list for which 'f returns non-nil
|
170
|
+
;; otherwise, return 'things if (f things) is non-nil
|
171
|
+
;; otherwise, nil
|
172
|
+
;; if 'f is not a function, self-invoke with a function checking for equality with f
|
173
|
+
;;
|
174
|
+
;; WARNING: if the detected thing is nil, returns t instead. A return value of nil
|
175
|
+
;; means the thing was not found ; non-nil means the thing was found, including when
|
176
|
+
;; the found thing is itself nil.
|
116
177
|
(def detect (f things)
|
117
|
-
; if 'f is a function,
|
118
|
-
; if 'things is a list, return the first item in the list for which 'f returns non-nil
|
119
|
-
; otherwise, return 'things if (f things) is non-nil
|
120
|
-
; otherwise, nil
|
121
|
-
; if 'f is not a function, self-invoke with a function checking for equality with f
|
122
|
-
;
|
123
|
-
; WARNING: if the detected thing is nil, returns t instead. A return value of nil
|
124
|
-
; means the thing was not found ; non-nil means the thing was found, including when
|
125
|
-
; the found thing is itself nil.
|
126
178
|
(if (isa 'fn f)
|
127
|
-
(
|
128
|
-
|
129
|
-
(let it (car items)
|
130
|
-
(or
|
131
|
-
(and (f it)
|
132
|
-
(or it t))
|
133
|
-
(d:cdr items)))
|
134
|
-
(f items)
|
135
|
-
items))
|
136
|
-
(detect (curry eq? f)
|
137
|
-
things)))
|
179
|
+
(detect-helper f things nil)
|
180
|
+
(detect-helper (fn (thing) (eq? f thing)) things nil)))
|
138
181
|
|
139
182
|
;; split things into a list of lists each n long
|
140
183
|
(def tuples (n things)
|
@@ -148,7 +191,9 @@
|
|
148
191
|
;; "better-p" -> takes two args a and b, return t if a is "better" than b, nil otherwise
|
149
192
|
(def best (better-p things)
|
150
193
|
(reduce (fn (a b)
|
151
|
-
(if (
|
194
|
+
(if (no b) a
|
195
|
+
(no a) b
|
196
|
+
(better-p a b) a b))
|
152
197
|
things))
|
153
198
|
|
154
199
|
(def min things (best < things))
|
@@ -235,9 +280,19 @@
|
|
235
280
|
(matchers things)
|
236
281
|
t))
|
237
282
|
|
238
|
-
|
283
|
+
;; given an arg 'f, invoke 'f with no args
|
239
284
|
(def self-invoke (f) (f))
|
240
285
|
|
286
|
+
;; returns a function @r@ that takes one argument, @f@
|
287
|
+
;; which when called, applies @f@ to the given @args@
|
288
|
+
;;
|
289
|
+
;; example: @(map (self-invoker 3) (list sqrt sqr ln inv exp fib fact))@
|
290
|
+
;; returns (1.732 9 1.098 0.333 20.085 4 6)
|
291
|
+
;; being respectively the sqrt, square, log, inverse, e**x, fibonacci, factorial of 3 (assuming such functions are previously defined)
|
292
|
+
;;
|
293
|
+
(def self-invoker args
|
294
|
+
λf(apply f args))
|
295
|
+
|
241
296
|
;; returns the first element of 'things iff it is the only element of 'things
|
242
297
|
(def list-single-element (things)
|
243
298
|
(if (no (cdr things)) (car things)))
|
@@ -247,3 +302,11 @@
|
|
247
302
|
(let c (counter)
|
248
303
|
(map (fn (thing) (f thing (c)))
|
249
304
|
things)))
|
305
|
+
|
306
|
+
;; takes a list of lists, returns a list of lists
|
307
|
+
;; transforms ((1 2 3) (a b c) (+ - *)) into ((1 a +) (2 b -) (3 c *))
|
308
|
+
;; the number of lists returned will be the number of items in the first of the given lists
|
309
|
+
(def rotate-2d-array (list-of-lists)
|
310
|
+
(with (size (len:car list-of-lists)
|
311
|
+
maps (map (fn (i) (fn (things) (nth i things))) (range 0 size)))
|
312
|
+
(map (fn (mapper) (map mapper list-of-lists)) maps)))
|
@@ -1,8 +1,8 @@
|
|
1
1
|
(assign show-failed-only t)
|
2
2
|
(assign all-tests nil)
|
3
3
|
|
4
|
+
;; register a test to be run later by 'run-all-tests
|
4
5
|
(def register-test (test)
|
5
|
-
; register a test to be run later by 'run-all-tests
|
6
6
|
(push test all-tests))
|
7
7
|
|
8
8
|
(def run-all-tests (verbose)
|
@@ -37,17 +37,13 @@
|
|
37
37
|
(failf))))))
|
38
38
|
|
39
39
|
(def execute-tests (desc tests passf failf verbose)
|
40
|
-
(
|
41
|
-
|
42
|
-
|
43
|
-
|
44
|
-
|
45
|
-
|
46
|
-
|
47
|
-
(cdr tests)
|
48
|
-
passf
|
49
|
-
failf
|
50
|
-
verbose)))
|
40
|
+
(while tests
|
41
|
+
(execute-test desc
|
42
|
+
(car tests)
|
43
|
+
passf
|
44
|
+
failf
|
45
|
+
verbose)
|
46
|
+
(= tests (cdr tests))))
|
51
47
|
|
52
48
|
(mac examples-for (name . examples)
|
53
49
|
(let suite-name "examples for ~(pp name)"
|
@@ -1,4 +1,3 @@
|
|
1
|
-
|
2
1
|
(assign prefix-list-prefixes ())
|
3
2
|
|
4
3
|
(def prefix-match-fn (txt)
|
@@ -6,28 +5,33 @@
|
|
6
5
|
|
7
6
|
(def find-prefix-rule (prefix)
|
8
7
|
(cdr:detect (prefix-match-fn prefix)
|
9
|
-
|
8
|
+
prefix-list-prefixes))
|
10
9
|
|
10
|
+
;; looks up a handler in 'prefix-list-prefixes
|
11
|
+
;; whose 'car matches the prefix, and whose 'cdr
|
12
|
+
;; is a function, which behaves like a macro, in that
|
13
|
+
;; it processes the prefix name and the prefixed list,
|
14
|
+
;; returning more code
|
11
15
|
(mac prefix-list (prefix list)
|
12
|
-
; looks up a handler in 'prefix-list-prefixes
|
13
|
-
; whose 'car matches the prefix, and whose 'cdr
|
14
|
-
; is a function, which behaves like a macro, in that
|
15
|
-
; it processes the prefix name and the prefixed list,
|
16
|
-
; returning more code
|
17
16
|
(let handler (find-prefix-rule prefix)
|
18
|
-
(
|
17
|
+
(if handler
|
18
|
+
(handler prefix list)
|
19
|
+
(error "unknown prefix-list syntax : ~(inspect prefix)"))))
|
19
20
|
|
21
|
+
;; define a macro to process a prefix-list where the prefix matches the given regex
|
22
|
+
;; param: 'regex is the regex which should match the list prefix
|
23
|
+
;; param: 'prefix-var is the variable whose value will be the actual matched prefix
|
24
|
+
;; param: 'list-var is the variable whose value will be the corresponding list
|
25
|
+
;; param: 'body the code which will actually transform the list
|
20
26
|
(mac define-prefix-list-macro (regex prefix-var list-var . body)
|
21
|
-
; define a macro to process a prefix-list where the prefix matches the given regex
|
22
|
-
; param: 'regex is the regex which should match the list prefix
|
23
|
-
; param: 'prefix-var is the variable whose value will be the actual matched prefix
|
24
|
-
; param: 'list-var is the variable whose value will be the corresponding list
|
25
|
-
; param: 'body the code which will actually transform the list
|
26
27
|
`(push (cons ,regex (fn (,prefix-var ,list-var) ,@body))
|
27
28
|
prefix-list-prefixes))
|
28
29
|
|
30
|
+
;; allows (map λa(upcase a.name) people)
|
31
|
+
;; as shortcut for (map (fn (a) (upcase a.name)) people)
|
29
32
|
(define-prefix-list-macro "^λ.*" vars expr
|
30
|
-
;; allows (map λa(upcase a.name) people)
|
31
|
-
;; as shortcut for (map (fn (a) (upcase a.name)) people)
|
32
33
|
(let var-list (map sym (collect !empty? (cdr:string-split vars "")))
|
33
34
|
`(fn ,var-list ,expr)))
|
35
|
+
|
36
|
+
(define-prefix-list-macro "\~" vars expr
|
37
|
+
`(to-string ,expr))
|
@@ -74,8 +74,8 @@
|
|
74
74
|
'pp/def
|
75
75
|
(list "pretty-printer for forms starting with ~(quote ,name)")
|
76
76
|
',args
|
77
|
-
'(pp/def ,name ,args ,@body)
|
78
|
-
|
77
|
+
'(pp/def ,name ,args ,@body)
|
78
|
+
(hash))))
|
79
79
|
|
80
80
|
(pp/def string-pieces (pp form indent) (pp/string-pieces pp (cdr form)))
|
81
81
|
(pp/def quasiquote (pp form indent) "`~(pp (cadr form) (cons "" indent))" )
|
@@ -85,7 +85,6 @@
|
|
85
85
|
(pp/def comment (pp form indent) "; ~(cadr form)\n")
|
86
86
|
(pp/def prefix-list (pp form indent) "~(cadr form)~(pp (caddr form))")
|
87
87
|
|
88
|
-
|
89
88
|
(def pp/brace-list-pair (pp (k v) indent) "~k ~(pp v indent)")
|
90
89
|
|
91
90
|
(pp/def brace-list (pp form indent)
|
@@ -124,7 +123,7 @@
|
|
124
123
|
(cons (firstn n form)
|
125
124
|
(map list (nthcdr n form))))
|
126
125
|
|
127
|
-
(def pp/flatly (form)
|
126
|
+
(def pp/flatly (form indent)
|
128
127
|
(if (pair? form)
|
129
128
|
(let special (hash-get pp/special-forms (car form))
|
130
129
|
(if special
|
@@ -136,8 +135,15 @@
|
|
136
135
|
(and (pair? form)
|
137
136
|
(> (len:pp/flatly form) 40)))
|
138
137
|
|
138
|
+
(def percent-syntax? (form)
|
139
|
+
(and (pair? form)
|
140
|
+
(sym? (car form))
|
141
|
+
(string-match (to-string (car form)) "^%")))
|
142
|
+
|
139
143
|
(def pp/breaker (form)
|
140
|
-
(if (
|
144
|
+
(if (percent-syntax? form)
|
145
|
+
(pp/split-form form 1)
|
146
|
+
(pair? form)
|
141
147
|
(let key (car form)
|
142
148
|
(if (or (eq? 'if key)
|
143
149
|
(eq? 'cond key))
|
@@ -164,6 +170,8 @@
|
|
164
170
|
(def pp/indent (sym indent)
|
165
171
|
(if (or (no sym) (pair? sym))
|
166
172
|
indent
|
173
|
+
(string-match (to-string sym) "^%")
|
174
|
+
(cons " " indent)
|
167
175
|
(cons (string-replace "." " " " ~sym") indent)))
|
168
176
|
|
169
177
|
(def pprint (form indent)
|
data/lib/lisp/core-090-hook.nydp
CHANGED
@@ -1,37 +1,37 @@
|
|
1
1
|
(chapter-start 'nydp/hooks "event management - execute a piece of code when something happens")
|
2
2
|
|
3
3
|
(let hooks {}
|
4
|
+
;; return the list of hook-names
|
4
5
|
(def hook-names ()
|
5
|
-
; return the list of hook-names
|
6
6
|
(hash-keys hooks))
|
7
7
|
|
8
|
+
;; return the list of hooks for 'hook-name
|
8
9
|
(def hooks-for (hook-name)
|
9
|
-
; return the list of hooks for 'hook-name
|
10
10
|
hooks.,hook-name)
|
11
11
|
|
12
|
+
;; add a function 'f to execute when 'hook-name is fired
|
12
13
|
(def add-hook (hook-name f)
|
13
|
-
; add a function 'f to execute when 'hook-name is fired
|
14
14
|
(hash-cons hooks hook-name f))
|
15
15
|
|
16
|
+
;; remove all hooks for 'hook-name
|
16
17
|
(def clear-hooks (hook-name)
|
17
|
-
; remove all hooks for 'hook-name
|
18
18
|
(= hooks.,hook-name nil))
|
19
19
|
|
20
|
+
;; temporarily remove all hooks for 'hook-name, restoring them after running 'f
|
20
21
|
(def without-hooks (hook-name f)
|
21
|
-
; temporarily remove all hooks for 'hook-name, restoring them after running 'f
|
22
22
|
(let previous-hooks (hooks-for hook-name)
|
23
23
|
(ensure (= hooks.,hook-name previous-hooks)
|
24
24
|
(clear-hooks hook-name)
|
25
25
|
(f))))
|
26
26
|
|
27
|
+
;; only works if you have a reference to the original function
|
27
28
|
(def remove-hook (hook-name f)
|
28
|
-
; only works if you have a reference to the original function
|
29
29
|
(= hooks.,hook-name
|
30
30
|
(collect (curry !eq? f)
|
31
31
|
hooks.,hook-name)))
|
32
32
|
|
33
|
+
;; apply all functions attached to 'hook-name to given 'args
|
33
34
|
(def run-hooks (hook-name . args)
|
34
|
-
; apply all functions attached to 'hook-name to given 'args
|
35
35
|
(each hook (hooks-for hook-name)
|
36
36
|
(apply hook args))))
|
37
37
|
|
@@ -42,9 +42,9 @@
|
|
42
42
|
;;
|
43
43
|
;; same as (add-hook 'transaction (fn (account amount) (update account total (+ account.total amount))))
|
44
44
|
;;
|
45
|
-
;; if 'body is
|
45
|
+
;; if 'body is a symbol and 'args is nil, for example
|
46
46
|
;;
|
47
|
-
;; (on transaction notify)
|
47
|
+
;; (on transaction () notify)
|
48
48
|
;;
|
49
49
|
;; 'notify must be a predefined function accepting any arguments to the 'transaction event ; the example is equivalent to
|
50
50
|
;;
|
@@ -59,8 +59,8 @@
|
|
59
59
|
(car body)
|
60
60
|
`(fn ,args ,@body))
|
61
61
|
(w/uniq dox-item
|
62
|
-
`(let ,dox-item (car:dox-lookup ',event)
|
63
|
-
|
62
|
+
`(let ,dox-item (or (car:dox-lookup ',event)
|
63
|
+
(dox-add-doc ',event 'hook))
|
64
64
|
(add-hook ',event ,hookfn)
|
65
65
|
(hash-cons ,dox-item 'hooks
|
66
66
|
{ src ',hookfn
|