nydp 0.4.1 → 0.5.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +5 -5
- data/README.md +44 -0
- data/lib/lisp/core-010-precompile.nydp +13 -16
- data/lib/lisp/core-012-utils.nydp +21 -6
- data/lib/lisp/core-015-documentation.nydp +58 -24
- data/lib/lisp/core-017-builtin-dox.nydp +49 -42
- data/lib/lisp/core-020-utils.nydp +5 -5
- data/lib/lisp/core-030-syntax.nydp +191 -96
- data/lib/lisp/core-035-flow-control.nydp +41 -14
- data/lib/lisp/core-037-list-utils.nydp +36 -14
- data/lib/lisp/core-039-module.nydp +24 -0
- data/lib/lisp/core-040-utils.nydp +51 -23
- data/lib/lisp/core-041-string-utils.nydp +37 -9
- data/lib/lisp/core-042-date-utils.nydp +21 -1
- data/lib/lisp/core-043-list-utils.nydp +99 -73
- data/lib/lisp/core-045-dox-utils.nydp +5 -0
- data/lib/lisp/core-070-prefix-list.nydp +1 -1
- data/lib/lisp/core-080-pretty-print.nydp +57 -17
- data/lib/lisp/core-090-hook.nydp +35 -1
- data/lib/lisp/core-100-utils.nydp +110 -15
- data/lib/lisp/core-110-hash-utils.nydp +61 -0
- data/lib/lisp/core-120-settings.nydp +46 -0
- data/lib/lisp/core-130-validations.nydp +51 -0
- data/lib/lisp/{core-060-benchmarking.nydp → core-900-benchmarking.nydp} +107 -19
- data/lib/lisp/tests/accum-examples.nydp +28 -1
- data/lib/lisp/tests/aif-examples.nydp +8 -3
- data/lib/lisp/tests/andify-examples.nydp +7 -0
- data/lib/lisp/tests/at-syntax-examples.nydp +17 -0
- data/lib/lisp/tests/best-examples.nydp +9 -0
- data/lib/lisp/tests/builtin-tests.nydp +19 -0
- data/lib/lisp/tests/case-examples.nydp +14 -0
- data/lib/lisp/tests/cdr-set-examples.nydp +6 -0
- data/lib/lisp/tests/date-examples.nydp +56 -1
- data/lib/lisp/tests/destructuring-examples.nydp +46 -14
- data/lib/lisp/tests/detect-examples.nydp +12 -0
- data/lib/lisp/tests/dp-examples.nydp +24 -0
- data/lib/lisp/tests/each-tests.nydp +5 -0
- data/lib/lisp/tests/empty-examples.nydp +1 -1
- data/lib/lisp/tests/error-tests.nydp +4 -4
- data/lib/lisp/tests/explain-mac-examples.nydp +1 -1
- data/lib/lisp/tests/filter-forms-examples.nydp +15 -0
- data/lib/lisp/tests/foundation-test.nydp +12 -0
- data/lib/lisp/tests/hash-examples.nydp +26 -2
- data/lib/lisp/tests/list-grep-examples.nydp +40 -0
- data/lib/lisp/tests/list-tests.nydp +58 -1
- data/lib/lisp/tests/map-hash-examples.nydp +11 -0
- data/lib/lisp/tests/module-examples.nydp +10 -0
- data/lib/lisp/tests/multi-assign-examples.nydp +6 -0
- data/lib/lisp/tests/parser-tests.nydp +25 -0
- data/lib/lisp/tests/pretty-print-tests.nydp +17 -14
- data/lib/lisp/tests/set-difference-examples.nydp +8 -0
- data/lib/lisp/tests/set-intersection-examples.nydp +16 -0
- data/lib/lisp/tests/set-union-examples.nydp +8 -0
- data/lib/lisp/tests/settings-examples.nydp +40 -0
- data/lib/lisp/tests/sort-examples.nydp +8 -0
- data/lib/lisp/tests/string-tests.nydp +65 -1
- data/lib/lisp/tests/syntax-tests.nydp +5 -1
- data/lib/lisp/tests/to-integer-examples.nydp +16 -0
- data/lib/lisp/tests/validation-examples.nydp +15 -0
- data/lib/lisp/tests/zap-examples.nydp +12 -0
- data/lib/nydp.rb +13 -7
- data/lib/nydp/assignment.rb +10 -3
- data/lib/nydp/builtin.rb +1 -1
- data/lib/nydp/builtin/abs.rb +8 -0
- data/lib/nydp/builtin/cdr_set.rb +1 -6
- data/lib/nydp/builtin/date.rb +15 -1
- data/lib/nydp/builtin/error.rb +1 -1
- data/lib/nydp/builtin/handle_error.rb +1 -1
- data/lib/nydp/builtin/hash.rb +27 -45
- 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/{car.rb → regexp.rb} +2 -2
- data/lib/nydp/builtin/ruby_wrap.rb +72 -0
- data/lib/nydp/builtin/string_match.rb +2 -2
- data/lib/nydp/builtin/string_pad_left.rb +7 -0
- data/lib/nydp/builtin/string_pad_right.rb +7 -0
- data/lib/nydp/builtin/string_replace.rb +1 -1
- data/lib/nydp/builtin/string_split.rb +4 -3
- data/lib/nydp/builtin/to_integer.rb +23 -0
- data/lib/nydp/builtin/to_string.rb +2 -9
- data/lib/nydp/builtin/type_of.rb +9 -6
- data/lib/nydp/closure.rb +0 -3
- data/lib/nydp/cond.rb +23 -1
- data/lib/nydp/context_symbol.rb +14 -6
- data/lib/nydp/core.rb +36 -28
- data/lib/nydp/core_ext.rb +54 -0
- data/lib/nydp/date.rb +37 -31
- data/lib/nydp/function_invocation.rb +34 -26
- data/lib/nydp/hash.rb +5 -6
- data/lib/nydp/helper.rb +41 -25
- data/lib/nydp/interpreted_function.rb +68 -40
- data/lib/nydp/literal.rb +1 -1
- data/lib/nydp/pair.rb +22 -5
- data/lib/nydp/parser.rb +11 -7
- data/lib/nydp/string_atom.rb +16 -22
- data/lib/nydp/symbol.rb +40 -27
- data/lib/nydp/symbol_lookup.rb +7 -7
- data/lib/nydp/tokeniser.rb +2 -2
- data/lib/nydp/truth.rb +17 -10
- data/lib/nydp/version.rb +1 -1
- data/lib/nydp/vm.rb +7 -2
- data/nydp.gemspec +2 -4
- data/spec/date_spec.rb +115 -22
- data/spec/embedded_spec.rb +12 -12
- data/spec/foreign_hash_spec.rb +14 -2
- data/spec/hash_non_hash_behaviour_spec.rb +7 -7
- data/spec/hash_spec.rb +24 -2
- data/spec/nydp_spec.rb +14 -2
- data/spec/pair_spec.rb +3 -1
- data/spec/parser_spec.rb +31 -20
- data/spec/rand_spec.rb +3 -3
- data/spec/spec_helper.rb +13 -1
- data/spec/symbol_spec.rb +31 -0
- data/spec/time_spec.rb +1 -1
- metadata +31 -38
- data/lib/nydp/builtin/cdr.rb +0 -7
- data/lib/nydp/builtin/cons.rb +0 -9
@@ -90,3 +90,8 @@ Examples for ~name
|
|
90
90
|
(chapter nydp/documentation)
|
91
91
|
(let ch (chapter-find chapter-name)
|
92
92
|
(= ch.contents (collect (fn (item) (!eq? item.name item-name)) ch.contents))))
|
93
|
+
|
94
|
+
; return the first dox item of the given type with the given name
|
95
|
+
(def dox-item-by-type (type name)
|
96
|
+
(let n (sym name)
|
97
|
+
(detect (fn (i) (eq? n i.name)) (dox-items-by-type type))))
|
@@ -29,5 +29,5 @@
|
|
29
29
|
(define-prefix-list-macro "^λ.*" vars expr
|
30
30
|
;; allows (map λa(upcase a.name) people)
|
31
31
|
;; as shortcut for (map (fn (a) (upcase a.name)) people)
|
32
|
-
(let var-list (map sym (collect !empty? (cdr:string-split vars)))
|
32
|
+
(let var-list (map sym (collect !empty? (cdr:string-split vars "")))
|
33
33
|
`(fn ,var-list ,expr)))
|
@@ -1,13 +1,39 @@
|
|
1
|
+
|
2
|
+
;;
|
3
|
+
;; problem: work out where a starting column of a form on its starting line, need to add
|
4
|
+
;; this amount to its indent if it is broken
|
5
|
+
;;
|
6
|
+
;; TODO:
|
7
|
+
;;
|
8
|
+
;; alternative approach: given a form <expr>, ask <expr> recursively
|
9
|
+
;; to provide the following:
|
10
|
+
;;
|
11
|
+
;; { inline: (... <sub-expr> <sub-expr> ...)
|
12
|
+
;; broken: (... <newline " "> <sub-expr> <newline " "> <sub-expr> ...) }
|
13
|
+
;;
|
14
|
+
;; printer returns <inline> if acceptable, otherwise produces <broken>, recursively deciding on <inline>
|
15
|
+
;; for each <sub-expr>
|
16
|
+
;;
|
17
|
+
;; each <newline " "> carries the amount of indent required for the containing form, needs to be added to
|
18
|
+
;; the amount of indent required for outer forms
|
19
|
+
;;
|
20
|
+
;;
|
21
|
+
;;
|
22
|
+
;; also TODO:
|
23
|
+
;;
|
24
|
+
;; use (module pp ...) and remove all those prefixes...
|
25
|
+
;;
|
26
|
+
|
1
27
|
(assign pp/special-forms (hash))
|
2
28
|
(assign pp/syntaxes (hash))
|
3
29
|
(assign pp/newline (uniq 'newline))
|
4
30
|
(assign pp/newline/noi (uniq 'newline/noi))
|
5
31
|
|
32
|
+
;; (eq? char "\n") "\\n"
|
6
33
|
(def pp/esc-ch (char)
|
7
34
|
(if (eq? char "\"") "\\\""
|
8
35
|
(eq? char "\~") "\\\~"
|
9
36
|
(eq? char "\\") "\\\\"
|
10
|
-
(eq? char "\n") "\\n"
|
11
37
|
char))
|
12
38
|
|
13
39
|
(def pp/esc-str-literal (txt)
|
@@ -17,6 +43,8 @@
|
|
17
43
|
(fn (thing)
|
18
44
|
(if (isa 'string thing)
|
19
45
|
(pp/esc-str-literal thing)
|
46
|
+
(isa 'symbol thing)
|
47
|
+
"\~|~(just thing)|"
|
20
48
|
"\~~(pp thing)")))
|
21
49
|
|
22
50
|
(def pp/string-pieces (pp things) "\"~(joinstr "" (map (pp/string-piece pp) things))\"")
|
@@ -35,11 +63,11 @@
|
|
35
63
|
(isa 'hash thing) "{ ~(joinstr " " (pp/kv thing)) }"
|
36
64
|
(inspect thing)))
|
37
65
|
|
66
|
+
;; define a pretty-printer function for forms beginning with the
|
67
|
+
;; given name. 'args are usually (form indent), form being the
|
68
|
+
;; complete form for pretty-printing, and indent being the current
|
69
|
+
;; indent level.
|
38
70
|
(mac pp/def (name args . body)
|
39
|
-
; define a pretty-printer function for forms beginning with the
|
40
|
-
; given name. 'args are usually (form indent), form being the
|
41
|
-
; complete form for pretty-printing, and indent being the current
|
42
|
-
; indent level.
|
43
71
|
`(do (hash-set pp/special-forms ',name
|
44
72
|
(fun ,args ,@body))
|
45
73
|
(dox-add-doc ',name
|
@@ -48,6 +76,7 @@
|
|
48
76
|
',args
|
49
77
|
'(pp/def ,name ,args ,@body))))
|
50
78
|
|
79
|
+
|
51
80
|
(pp/def string-pieces (pp form indent) (pp/string-pieces pp (cdr form)))
|
52
81
|
(pp/def quasiquote (pp form indent) "`~(pp (cadr form) (cons "" indent))" )
|
53
82
|
(pp/def quote (pp form indent) "'~(pp (cadr form) (cons "" indent))" )
|
@@ -55,7 +84,12 @@
|
|
55
84
|
(pp/def unquote-splicing (pp form indent) ",@~(pp (cadr form) (cons " " indent))")
|
56
85
|
(pp/def comment (pp form indent) "; ~(cadr form)\n")
|
57
86
|
(pp/def prefix-list (pp form indent) "~(cadr form)~(pp (caddr form))")
|
58
|
-
|
87
|
+
|
88
|
+
|
89
|
+
(def pp/brace-list-pair (pp (k v) indent) "~k ~(pp v indent)")
|
90
|
+
|
91
|
+
(pp/def brace-list (pp form indent)
|
92
|
+
"{ ~(joinstr " " (map λe(pprint e (cons " " indent)) (intersperse-splicing pp/newline (pairs:cdr form)))) }")
|
59
93
|
|
60
94
|
(def pp/unsyntax (form)
|
61
95
|
(if (pair? form)
|
@@ -65,15 +99,16 @@
|
|
65
99
|
(map pp/unsyntax form)))
|
66
100
|
form))
|
67
101
|
|
68
|
-
(hash-set pp/syntaxes 'percent-syntax
|
69
|
-
(hash-set pp/syntaxes 'colon-syntax
|
70
|
-
(hash-set pp/syntaxes 'dot-syntax
|
71
|
-
(hash-set pp/syntaxes 'bang-syntax
|
72
|
-
(hash-set pp/syntaxes 'ampersand-syntax
|
73
|
-
(hash-set pp/syntaxes 'dollar-syntax
|
74
|
-
(hash-set pp/syntaxes 'colon-colon-syntax "::")
|
75
|
-
(hash-set pp/syntaxes 'arrow-syntax
|
76
|
-
(hash-set pp/syntaxes 'rocket-syntax
|
102
|
+
(hash-set pp/syntaxes 'percent-syntax "%" )
|
103
|
+
(hash-set pp/syntaxes 'colon-syntax ":" )
|
104
|
+
(hash-set pp/syntaxes 'dot-syntax "." )
|
105
|
+
(hash-set pp/syntaxes 'bang-syntax "!" )
|
106
|
+
(hash-set pp/syntaxes 'ampersand-syntax "&" )
|
107
|
+
(hash-set pp/syntaxes 'dollar-syntax "$" )
|
108
|
+
(hash-set pp/syntaxes 'colon-colon-syntax "::" )
|
109
|
+
(hash-set pp/syntaxes 'arrow-syntax "->" )
|
110
|
+
(hash-set pp/syntaxes 'rocket-syntax "=>" )
|
111
|
+
(hash-set pp/syntaxes 'at-syntax "@" )
|
77
112
|
|
78
113
|
(def pp/dotify (form)
|
79
114
|
(if (pair? form)
|
@@ -160,9 +195,14 @@
|
|
160
195
|
(pprint (pp/break-pair form) indent)
|
161
196
|
(pp/literal form indent)))
|
162
197
|
|
198
|
+
;; better than (def pp (form) (inspect form))
|
163
199
|
(def pp (form) (pp/cleanup:pp/printer (pp/dotify:pp/unsyntax form) nil))
|
164
|
-
;; (def pp (form) (inspect form))
|
165
200
|
|
201
|
+
;; use the pretty-printer to elegantly display the given source code
|
166
202
|
(def dox-show-src (src)
|
167
|
-
; use the pretty-printer to elegantly display the given source code
|
168
203
|
(pp src))
|
204
|
+
|
205
|
+
;; use 'pp/unsyntax to convert 'def and 'mac names back to a symbol
|
206
|
+
;; so (mac dsl.foo (a1 a2) ...) will be documented as "dsl.foo"
|
207
|
+
(def dox-build-def-name (name)
|
208
|
+
(pp/unsyntax name))
|
data/lib/lisp/core-090-hook.nydp
CHANGED
@@ -35,7 +35,39 @@
|
|
35
35
|
(each hook (hooks-for hook-name)
|
36
36
|
(apply hook args))))
|
37
37
|
|
38
|
-
|
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
|
+
;;
|
57
|
+
(mac on (event args . body)
|
58
|
+
(let hookfn (if (isa 'symbol (car body))
|
59
|
+
(car body)
|
60
|
+
`(fn ,args ,@body))
|
61
|
+
(w/uniq dox-item
|
62
|
+
`(let ,dox-item (car:dox-lookup ',event)
|
63
|
+
(if (no ,dox-item) (error "unknown hook ~(just ',event)"))
|
64
|
+
(add-hook ',event ,hookfn)
|
65
|
+
(hash-cons ,dox-item 'hooks
|
66
|
+
{ src ',hookfn
|
67
|
+
args ',args
|
68
|
+
chapter (chapter-current)
|
69
|
+
file this-script
|
70
|
+
plugin this-plugin })))))
|
39
71
|
|
40
72
|
(let super warnings/new
|
41
73
|
(def warnings/new (kind . info)
|
@@ -43,3 +75,5 @@
|
|
43
75
|
(chapter nydp/warnings)
|
44
76
|
(apply super kind info)
|
45
77
|
(run-hooks 'warnings/new (cons kind info))))
|
78
|
+
|
79
|
+
(on warnings/new w (apply p w))
|
@@ -1,3 +1,5 @@
|
|
1
|
+
(chapter-start 'list-manipulation)
|
2
|
+
|
1
3
|
(def include? (thing things)
|
2
4
|
; alias for 'detect
|
3
5
|
; true if thing is in things, nil otherwise
|
@@ -15,6 +17,16 @@
|
|
15
17
|
(map λx(hash-get tmp x)
|
16
18
|
(sort:hash-keys tmp)))))
|
17
19
|
|
20
|
+
; like 'sort-by, except when 'f returns nil, use 'instead as the sort key instead
|
21
|
+
(def safe-sort-by (f instead things)
|
22
|
+
(sort-by λi(or (f i) instead) things))
|
23
|
+
|
24
|
+
;; takes a function f, returns a new function that takes a list and sorts the list by 'f
|
25
|
+
(def sort-by-f (f) (curry1 sort-by f))
|
26
|
+
|
27
|
+
;; takes a function f, returns a new function that takes a list and sorts the list by 'f
|
28
|
+
(def safe-sort-by-f (f instead) (curry1 safe-sort-by f instead))
|
29
|
+
|
18
30
|
(def mapreduce (fmap freduce things)
|
19
31
|
; same as (reduce freduce (map fmap things))
|
20
32
|
; returns the resulting list
|
@@ -28,9 +40,6 @@
|
|
28
40
|
; map 'f over 'things and sum the resulting list
|
29
41
|
(def mapsum (f things) (mapreduce f + things))
|
30
42
|
|
31
|
-
; return values for each key in hash 'h
|
32
|
-
(def hash-values (h) (map (fn (k) h.,k) (hash-keys h)))
|
33
|
-
|
34
43
|
(def seen? ()
|
35
44
|
; returns a new function f which takes a parameter x
|
36
45
|
; for each call to f with any value Z for x
|
@@ -44,9 +53,9 @@
|
|
44
53
|
; return a list containing all the elements of 'things, but with no duplicates
|
45
54
|
(def uniqify (things) (reject (seen?) things))
|
46
55
|
|
56
|
+
;; return a hash of 'things keyed by (f thing) for
|
57
|
+
;; each thing in 'things
|
47
58
|
(def group-by (f things)
|
48
|
-
; return a hash of 'things keyed by (f thing) for
|
49
|
-
; each thing in 'things
|
50
59
|
(returnlet hsh {}
|
51
60
|
(each thing things
|
52
61
|
(hash-cons hsh (f thing) thing))))
|
@@ -61,18 +70,40 @@
|
|
61
70
|
(let mi (m2i anchor)
|
62
71
|
(map λm(i2m (+ mi m)) mm))))
|
63
72
|
|
64
|
-
|
65
|
-
|
66
|
-
|
73
|
+
;; each call to the name 'accfn-name with an arg will append the arg to the end of a list.
|
74
|
+
;; This form returns the resulting list.
|
75
|
+
;; Example (collect first names from a list of people)
|
76
|
+
;;
|
77
|
+
;; (accum a (each person people (a person.firstname)))
|
78
|
+
;;
|
79
|
+
;; will return (Alice Bob Carol Declan Eliza Fionn)
|
80
|
+
;;
|
67
81
|
(mac accum (accfn-name . body)
|
68
|
-
(w/uniq
|
69
|
-
`(
|
70
|
-
(
|
82
|
+
(w/uniq (things last-cons)
|
83
|
+
`(with (,last-cons (cons) ,things nil)
|
84
|
+
(= ,things ,last-cons)
|
85
|
+
(let ,accfn-name (fn (a) (= ,last-cons (cdr-set ,last-cons (cons a))) a)
|
71
86
|
,@body
|
72
|
-
(
|
73
|
-
|
74
|
-
|
75
|
-
|
87
|
+
(cdr ,things)))))
|
88
|
+
|
89
|
+
;; like 'accum, except 'accfn-name expects 2 args, a key and a value
|
90
|
+
;; value is hash-consed onto key in an internally-maintained hash
|
91
|
+
;; the form returns the resulting hash
|
92
|
+
;; values are in reverse order
|
93
|
+
(mac accum-hash (accfn-name . body)
|
94
|
+
(w/uniq (hsh)
|
95
|
+
`(with (,hsh (hash))
|
96
|
+
(let ,accfn-name (fn (k a) (hash-cons ,hsh k a))
|
97
|
+
,@body
|
98
|
+
,hsh))))
|
99
|
+
|
100
|
+
; return a list containing the range of elements starting with 'start,
|
101
|
+
; up to but not including 'stop
|
102
|
+
(def range (start stop)
|
103
|
+
(accum acc
|
104
|
+
(rfnwith r (n start)
|
105
|
+
(if (< n stop)
|
106
|
+
(r (+ (acc n) 1))))))
|
76
107
|
|
77
108
|
; return a function that returns 'start on first invocation,
|
78
109
|
; and 'start + n * 'incr for each nth invocation
|
@@ -145,3 +176,67 @@
|
|
145
176
|
(fill-buckets others max buckets size-f key))))
|
146
177
|
(fill-buckets items max (bucket/new buckets) size-f key))
|
147
178
|
buckets))
|
179
|
+
|
180
|
+
; return the list except for the last element
|
181
|
+
(def all-but-last (things)
|
182
|
+
(accum acc
|
183
|
+
((afn (xs)
|
184
|
+
(when (cdr xs)
|
185
|
+
(acc (car xs))
|
186
|
+
(self (cdr xs))))
|
187
|
+
things)))
|
188
|
+
|
189
|
+
;; returns a list containing 'existing items, that has at least 'minimum items, building new items if necessary
|
190
|
+
;;
|
191
|
+
;; useful if you want to show, for example, two parent fields, but you don't know in advance whether there
|
192
|
+
;; are zero, one, two, or more parents already present
|
193
|
+
;;
|
194
|
+
;; existing: the existing list
|
195
|
+
;; buildf: a zero-argument function to build a new item
|
196
|
+
;; minimum: the minimum number of items in the returned list.
|
197
|
+
;;
|
198
|
+
(def list/fill (existing buildf minimum)
|
199
|
+
(let missing (- minimum (len existing))
|
200
|
+
(if (> missing 0)
|
201
|
+
(+ existing (map buildf (range 0 missing)))
|
202
|
+
existing)))
|
203
|
+
|
204
|
+
;; recursively search the given form for forms matching 'matcher
|
205
|
+
;; matcher is a function which returns nil for non-match, anything else for match
|
206
|
+
;; returns the list of non-nil objects returned by 'matcher
|
207
|
+
;; 'matcher will be called with the entire form, and if the form is a list, with each element of the form, recursively
|
208
|
+
(def list/grep (matcher form)
|
209
|
+
(accum matches
|
210
|
+
(let maybe λi(if (matcher i) (matches i))
|
211
|
+
(list/traverse maybe maybe form))))
|
212
|
+
|
213
|
+
;; recursively seeks forms in 'form whose car is 'symbol
|
214
|
+
(def list/seek-cars (symbol form)
|
215
|
+
(list/grep λf(caris symbol f) form))
|
216
|
+
|
217
|
+
;; helper function for 'case macro
|
218
|
+
(def case/make-conds (test varname conds acc)
|
219
|
+
(if conds
|
220
|
+
(let (cnd expr) (car conds)
|
221
|
+
(if (eq? cnd 'else)
|
222
|
+
(acc expr)
|
223
|
+
(do (acc `(,test ,varname ,cnd))
|
224
|
+
(acc expr)
|
225
|
+
(case/make-conds test
|
226
|
+
varname
|
227
|
+
(cdr conds)
|
228
|
+
acc))))))
|
229
|
+
|
230
|
+
;; usage: (case eq? person.name
|
231
|
+
;; "conan" (greet person)
|
232
|
+
;; "egg" (delete person)
|
233
|
+
;; "bach" (play person)
|
234
|
+
;; else (interrogate person))
|
235
|
+
(mac case (test what . conditions)
|
236
|
+
(w/uniq caseval
|
237
|
+
`(let ,caseval ,what
|
238
|
+
(if ,@(accum a
|
239
|
+
(case/make-conds test
|
240
|
+
caseval
|
241
|
+
(pairs conditions)
|
242
|
+
a))))))
|
@@ -0,0 +1,61 @@
|
|
1
|
+
(chapter-start 'hash-manipulation "utilities for manipulating, accessing and altering hash objects")
|
2
|
+
|
3
|
+
; return values for each key in hash 'h
|
4
|
+
(def hash-values (h)
|
5
|
+
(map λk(hash-get h k)
|
6
|
+
(hash-keys h)))
|
7
|
+
|
8
|
+
; (auto-hash a b c) same as { a a b b c c }
|
9
|
+
(mac auto-hash names
|
10
|
+
`(brace-list ,@(flatten:map λn(list n n) names)))
|
11
|
+
|
12
|
+
;; like 'map, but for a hash instead of a list ; provided function 'f takes three arguments,
|
13
|
+
;; a key, the corresponding value from the given hash, and the index of the item in the list
|
14
|
+
(def map-hash (f h pre)
|
15
|
+
(map-with-index λki(f k (hash-get h k) i)
|
16
|
+
((or pre x1) (hash-keys h))))
|
17
|
+
|
18
|
+
;; returns a new hash with the same keys as the given hash, with each value transformed by
|
19
|
+
;; the given function 'f
|
20
|
+
;; 'f takes three arguments:
|
21
|
+
;; k, the key
|
22
|
+
;; v, the value
|
23
|
+
;; i, the index
|
24
|
+
;;
|
25
|
+
(def hash-transform-values (f h pre)
|
26
|
+
(returnlet newh {}
|
27
|
+
(map-hash λkvi(hash-set newh k (f k v i)))))
|
28
|
+
|
29
|
+
|
30
|
+
;; Return a new hash where keys are (map f things) and values are the corresponding things.
|
31
|
+
;; No attempt is made to avoid clobbering items. Use 'group-by if there are duplicate keys.
|
32
|
+
(def hashify (f things)
|
33
|
+
(returnlet hsh {}
|
34
|
+
(each thing things
|
35
|
+
(hash-set hsh (f thing) thing))))
|
36
|
+
|
37
|
+
;; like 'group-by, except 'f returns multiple items, each of which
|
38
|
+
;; is used to key the thing in question
|
39
|
+
(def subgroup-by (f things)
|
40
|
+
(returnlet hsh {}
|
41
|
+
(each thing things
|
42
|
+
(each k (f thing)
|
43
|
+
(hash-cons hsh k thing)))))
|
44
|
+
|
45
|
+
;; return a new hash containing all the values of the given
|
46
|
+
;; hash, but with each corresponding key 'k replaced by (f k)
|
47
|
+
(def hash-replace-keys (f hsh)
|
48
|
+
(returnlet newh {}
|
49
|
+
(each k (hash-keys hsh)
|
50
|
+
(hash-set newh (f k) (hash-get hsh k)))))
|
51
|
+
|
52
|
+
;; repeatedly assigns an element of hash-keys of 'things to 'kvar,
|
53
|
+
;; assign the corresponding value to 'vvar
|
54
|
+
;; and executes 'body for each key-value pair
|
55
|
+
;; return value of form is whatever the last line of 'body returns
|
56
|
+
(mac hash-each (kvar vvar things . body)
|
57
|
+
(w/uniq xs
|
58
|
+
`(let ,xs ,things
|
59
|
+
(each ,kvar (hash-keys ,xs)
|
60
|
+
(let ,vvar (hash-get ,xs ,kvar)
|
61
|
+
,@body)))))
|
@@ -0,0 +1,46 @@
|
|
1
|
+
(chapter-start 'settings "Utilities for managing settings")
|
2
|
+
|
3
|
+
(assign settings {})
|
4
|
+
(assign initial-settings {})
|
5
|
+
|
6
|
+
; convert expr to a function that returns the expr, unless expr is a symbol in which case we assume it already refers to a fn
|
7
|
+
(def settings/fn (expr)
|
8
|
+
(if (sym? expr) expr
|
9
|
+
(or (atom? expr) (no expr)) `(k ,expr)
|
10
|
+
(hash? expr) `(k ',expr)
|
11
|
+
(caris 'quote expr) `(k ,expr)
|
12
|
+
(caris 'brace-list expr) `(k ,expr)
|
13
|
+
`(fn (_) ,expr)))
|
14
|
+
|
15
|
+
; update value of setting 'name
|
16
|
+
(mac set-setting (name value)
|
17
|
+
`(do (hash-cons (dox-item-by-type 'setting ',(sym name))
|
18
|
+
'values
|
19
|
+
{ plugin this-plugin script this-script value ',value })
|
20
|
+
(hash-set settings ',(sym name) ,(settings/fn value))))
|
21
|
+
|
22
|
+
; update value of setting 'name
|
23
|
+
(mac reset-setting (name)
|
24
|
+
`(set-setting ,name ,(hash-get initial-settings (sym name))))
|
25
|
+
|
26
|
+
(mac def-setting (name initial)
|
27
|
+
; define a setting in the given 'context with a 'name and an 'initial value, with a 'doc to explain it
|
28
|
+
; if value is a function, it is invoked with 'context and 'name to retrieve its value
|
29
|
+
; if value is a constant, it is wrapped in a function to return the constant
|
30
|
+
(let context (car:string-split name ".")
|
31
|
+
`(do (dox-add-doc ',(sym name)
|
32
|
+
'setting
|
33
|
+
',(fetch-and-clear-comments)
|
34
|
+
nil
|
35
|
+
'(def-setting ,name ,initial)
|
36
|
+
'(,(sym "settings/~context"))
|
37
|
+
{ setting { default ',initial context ',context name ',name } })
|
38
|
+
(hash-set initial-settings ',(sym name) ',initial)
|
39
|
+
(set-setting ,(sym name) ,initial))))
|
40
|
+
|
41
|
+
; get the value of the given setting. Raises an error if the setting is unknown
|
42
|
+
(def setting (name)
|
43
|
+
(aif (hash-get settings (sym name))
|
44
|
+
(on-err (error "can't get value of setting ~name : stored object is ~(inspect it)")
|
45
|
+
(it name))
|
46
|
+
(error "unknown setting ~(inspect name)")))
|