nydp 0.2.1 → 0.2.2
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/lib/lisp/core-012-utils.nydp +3 -4
- data/lib/lisp/core-015-documentation.nydp +11 -10
- data/lib/lisp/core-017-builtin-dox.nydp +1 -1
- data/lib/lisp/core-040-utils.nydp +34 -7
- data/lib/lisp/core-050-test-runner.nydp +2 -2
- data/lib/lisp/core-060-benchmarking.nydp +62 -8
- data/lib/lisp/core-080-pretty-print.nydp +131 -78
- data/lib/lisp/tests/boot-tests.nydp +8 -0
- data/lib/lisp/tests/intersperse-examples.nydp +57 -0
- data/lib/lisp/tests/invocation-tests.nydp +60 -10
- data/lib/lisp/tests/list-tests.nydp +14 -1
- data/lib/lisp/tests/pretty-print-tests.nydp +274 -15
- data/lib/lisp/tests/sort-examples.nydp +3 -1
- data/lib/nydp/compiler.rb +2 -1
- data/lib/nydp/context_symbol.rb +38 -43
- data/lib/nydp/function_invocation.rb +70 -0
- data/lib/nydp/lexical_context.rb +39 -59
- data/lib/nydp/lexical_context_builder.rb +84 -176
- data/lib/nydp/symbol.rb +5 -1
- data/lib/nydp/symbol_lookup.rb +2 -24
- data/lib/nydp/version.rb +1 -1
- metadata +3 -2
checksums.yaml
CHANGED
@@ -1,7 +1,7 @@
|
|
1
1
|
---
|
2
2
|
SHA1:
|
3
|
-
metadata.gz:
|
4
|
-
data.tar.gz:
|
3
|
+
metadata.gz: 0efb226f96102a49ecfc52dcd363de20d26a7f3f
|
4
|
+
data.tar.gz: f8423c03ffc9f016396d9daf7934f6a3e5df133d
|
5
5
|
SHA512:
|
6
|
-
metadata.gz:
|
7
|
-
data.tar.gz:
|
6
|
+
metadata.gz: b5c3030351ffef2de2d5e922f1f75c4639ca0ef7a616301335b7c015c172461865421502c0615bd594186702f6fe29244a14ae25a1c9959913a5d457d6eabd9f
|
7
|
+
data.tar.gz: 87d733099303526473ef61fb7b3e75738b7f2b3f86698fa5bc1f26d811c5fd54c7f359b0fe675ddd521fde85185e3c577bd0c0fae94b57955ae6a5399b5e1bc4
|
@@ -10,11 +10,10 @@
|
|
10
10
|
(def map (f things)
|
11
11
|
; transforms the list 'things by applying 'f to each item
|
12
12
|
; returns the resulting list
|
13
|
-
(if (
|
14
|
-
nil
|
15
|
-
(pair? things)
|
13
|
+
(if (pair? things)
|
16
14
|
(cons (f (car things)) (map f (cdr things)))
|
17
|
-
|
15
|
+
things
|
16
|
+
(f things)))
|
18
17
|
|
19
18
|
(def hash-cons (h k v)
|
20
19
|
; push 'v onto the value for 'k in 'h
|
@@ -1,4 +1,6 @@
|
|
1
|
-
(
|
1
|
+
(def privately () nil)
|
2
|
+
|
3
|
+
((fn (this-chapter-name chapters chapter-new chapter-build chapter-find-by-name chapter-add-to-chapter)
|
2
4
|
(assign chapters (hash))
|
3
5
|
|
4
6
|
(def chapter-end ()
|
@@ -20,15 +22,13 @@
|
|
20
22
|
(cond name
|
21
23
|
(hash-set chapters
|
22
24
|
name
|
23
|
-
(chapter-new (hash)
|
24
|
-
|
25
|
+
(chapter-new (hash) name)))))
|
26
|
+
|
27
|
+
(def chapter-find-by-name (name)
|
28
|
+
(chapter-build name (hash-get chapters name)))
|
25
29
|
|
26
30
|
(def chapter-find (name)
|
27
|
-
(chapter-
|
28
|
-
name
|
29
|
-
this-chapter-name)
|
30
|
-
(hash-get chapters
|
31
|
-
name)))
|
31
|
+
(chapter-find-by-name (cond name name this-chapter-name)))
|
32
32
|
|
33
33
|
(def chapter-add-to-chapter (chapter attribute thing)
|
34
34
|
(cond chapter
|
@@ -46,7 +46,7 @@
|
|
46
46
|
description)))))
|
47
47
|
|
48
48
|
(assign this-script nil)
|
49
|
-
(assign this-plugin
|
49
|
+
(assign this-plugin "Nydp Core")
|
50
50
|
|
51
51
|
((fn (dox examples chapters dox-new dox-build)
|
52
52
|
(def dox-build (hsh name what texts args src chapters)
|
@@ -65,7 +65,8 @@
|
|
65
65
|
(dox-add-to-chapters item (hash-get item 'chapters)))
|
66
66
|
|
67
67
|
(def dox-add-doc (name what texts args src chapters)
|
68
|
-
(
|
68
|
+
(cond (no (privately))
|
69
|
+
(dox-new (dox-build (hash) name what texts args src chapters))))
|
69
70
|
|
70
71
|
(def dox-add-to-chapters (item chapters)
|
71
72
|
(chapter-add-item item)
|
@@ -11,7 +11,7 @@
|
|
11
11
|
(dox-add-doc 'eval 'def '("evaluate the given lisp expression") '(expr) nil '(nydp-core))
|
12
12
|
(dox-add-doc 'hash 'def '("create a new Hash instance") nil nil '(hash-manipulation))
|
13
13
|
(dox-add-doc 'apply 'def '("invoke f with args 'args") '(f . args) nil '(nydp-core))
|
14
|
-
(dox-add-doc 'date 'def '("create a new date instance") '(year month day) nil '(time
|
14
|
+
(dox-add-doc 'date 'def '("create a new date instance") '(year month day) nil '(date-time))
|
15
15
|
(dox-add-doc 'error 'def '("raise an exception") 'args nil '(flow-control))
|
16
16
|
(dox-add-doc 'parse 'def '("parse the given string and return the corresponding lisp objects") '(str) nil '(nydp-core))
|
17
17
|
(dox-add-doc 'p 'def '("print a message on $stdout") 'args nil '(nydp-core))
|
@@ -24,12 +24,32 @@
|
|
24
24
|
(push x acc)))
|
25
25
|
acc))
|
26
26
|
|
27
|
+
(def list-slices (things slice-size)
|
28
|
+
; slice 'things into a list of lists each with maximum 'slice-size items
|
29
|
+
(chapter pagination)
|
30
|
+
(chapter list-manipulation)
|
31
|
+
(if (< (len things) slice-size)
|
32
|
+
(cons things nil)
|
33
|
+
(cons (firstn slice-size things)
|
34
|
+
(list-slices (nthcdr slice-size things)
|
35
|
+
slice-size))))
|
36
|
+
|
37
|
+
(def intersperse (inbetween things)
|
38
|
+
; return a new list with 'inbetween in between every element of 'things
|
39
|
+
(if (and (pair? things) (cdr things))
|
40
|
+
(apply list (car things) inbetween
|
41
|
+
(intersperse inbetween (cdr things)))
|
42
|
+
things))
|
43
|
+
|
44
|
+
(def intersperse-splicing (inbetween things)
|
45
|
+
; expects 'things a list of lists, joins the lists
|
46
|
+
; placing 'inbetween in between each list.
|
47
|
+
; For example (intersperse-splicing 'X '((a b) (c d) (e f)))
|
48
|
+
; returns (a b X c d X e f)
|
49
|
+
(apply joinlists (intersperse (list inbetween) things)))
|
50
|
+
|
27
51
|
(def string-strip (txt)
|
28
|
-
(string-replace "
|
29
|
-
""
|
30
|
-
(string-replace "^\\s+"
|
31
|
-
""
|
32
|
-
txt)))
|
52
|
+
(string-replace "(^\\s+|\\s+$)" "" txt))
|
33
53
|
|
34
54
|
(def joinstr (txt . things)
|
35
55
|
; flatten 'things into a single list (ie unnest lists)
|
@@ -45,7 +65,8 @@
|
|
45
65
|
|
46
66
|
(def j items
|
47
67
|
; delegate to 'joinstr with an empty join string
|
48
|
-
(joinstr "" items)
|
68
|
+
; shortcut for (joinstr "" items)
|
69
|
+
(joinstr "" items))
|
49
70
|
|
50
71
|
(def string-pieces pieces
|
51
72
|
; string-interpolation syntax emits this form. Default implementation
|
@@ -143,7 +164,7 @@
|
|
143
164
|
(,rfname ,test)))))
|
144
165
|
|
145
166
|
(mac loop (start test update . body)
|
146
|
-
; execute 'start
|
167
|
+
; execute 'start, then for as long as 'test returns non-nil,
|
147
168
|
; execute 'body and 'update
|
148
169
|
(w/uniq (gfn gparm)
|
149
170
|
`(do ,start
|
@@ -153,15 +174,21 @@
|
|
153
174
|
,test))))
|
154
175
|
|
155
176
|
(mac for (v init max . body)
|
177
|
+
; assign 'init to 'v, then execute 'body 'max times,
|
178
|
+
; incrementing 'v at each iteration
|
156
179
|
(w/uniq (gi gm)
|
157
180
|
`(with (,v nil ,gi ,init ,gm (+ ,max 1))
|
158
181
|
(loop (assign ,v ,gi) (< ,v ,gm) (assign ,v (+ ,v 1))
|
159
182
|
,@body))))
|
160
183
|
|
161
184
|
(mac mapx (things x expr)
|
185
|
+
; a macro wrapper for 'map
|
186
|
+
; 'things is a list, 'x is the name of a variable, and 'expr
|
187
|
+
; is evaluated and collected for each 'x in 'things
|
162
188
|
`(map (fn (,x) ,expr) ,things))
|
163
189
|
|
164
190
|
(def atom? (thing)
|
191
|
+
; 't if 'thing is not a list or a hash
|
165
192
|
(and thing
|
166
193
|
(!pair? thing)
|
167
194
|
(!hash? thing)))
|
@@ -2,11 +2,11 @@
|
|
2
2
|
(assign all-tests nil)
|
3
3
|
|
4
4
|
(def register-test (test)
|
5
|
-
|
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)
|
9
|
-
|
9
|
+
; runs all tests that have been registered with 'register-test
|
10
10
|
(with (passed 0 failed 0)
|
11
11
|
(with (f-pass (fn nil (assign passed (+ 1 passed)))
|
12
12
|
f-fail (fn nil (assign failed (+ 1 failed))))
|
@@ -1,3 +1,4 @@
|
|
1
|
+
|
1
2
|
(def bm-pythag ()
|
2
3
|
(for i 1 50
|
3
4
|
(for j 1 50
|
@@ -20,6 +21,27 @@
|
|
20
21
|
(p "================================================\n")
|
21
22
|
"~desc : total ~(just times), average ~(/ times repeats) per run"))
|
22
23
|
|
24
|
+
(assign a 1)
|
25
|
+
(assign b 1)
|
26
|
+
|
27
|
+
(def bm-add-globals () (+ a b))
|
28
|
+
|
29
|
+
(def bm-lc-0 () 0)
|
30
|
+
(def bm-lc-1 (a) a)
|
31
|
+
(def bm-lc-2 (a b) (a b))
|
32
|
+
(def bm-lc-3 (a b c) (a b c))
|
33
|
+
(def bm-lc-4 (a b c d) (a b c d))
|
34
|
+
|
35
|
+
(def bm-lc-0R a a)
|
36
|
+
(def bm-lc-1R (a . b) (apply a b))
|
37
|
+
(def bm-lc-2R (a b . c) (apply a b c))
|
38
|
+
(def bm-lc-3R (a b c . d) (apply a b c d))
|
39
|
+
(def bm-lc-4R (a b c d . e) (apply a b c d e))
|
40
|
+
|
41
|
+
(def bm-plus-0 () (+))
|
42
|
+
(def bm-plus-1 (a) (+ a))
|
43
|
+
(def bm-plus-2 (a b) (+ a b))
|
44
|
+
(def bm-plus-3 (a b c) (+ a b c))
|
23
45
|
|
24
46
|
(def bm-0-arg-times-call () (*))
|
25
47
|
(def bm-1-arg-times-call () (* 23))
|
@@ -27,6 +49,23 @@
|
|
27
49
|
(def bm-3-arg-times-call () (* 23 24 25))
|
28
50
|
(def bm-4-arg-times-call () (* 23 24 25 26))
|
29
51
|
|
52
|
+
(def bm-plus-0-call () (bm-plus-0))
|
53
|
+
(def bm-plus-1-call () (bm-plus-1 1))
|
54
|
+
(def bm-plus-2-call () (bm-plus-2 1 2))
|
55
|
+
(def bm-plus-3-call () (bm-plus-3 1 2 3))
|
56
|
+
|
57
|
+
(def bm-0-lc-call () (bm-lc-0))
|
58
|
+
(def bm-1-lc-call () (bm-lc-1 +))
|
59
|
+
(def bm-2-lc-call () (bm-lc-2 + 1))
|
60
|
+
(def bm-3-lc-call () (bm-lc-3 + 1 2))
|
61
|
+
(def bm-4-lc-call () (bm-lc-4 + 1 2 3))
|
62
|
+
|
63
|
+
(def bm-0R-lc-call () (bm-lc-0R +))
|
64
|
+
(def bm-1R-lc-call () (bm-lc-1R + 1))
|
65
|
+
(def bm-2R-lc-call () (bm-lc-2R + 1 2))
|
66
|
+
(def bm-3R-lc-call () (bm-lc-3R + 1 2 3))
|
67
|
+
(def bm-4R-lc-call () (bm-lc-4R + 1 2 3 4))
|
68
|
+
|
30
69
|
(def bm-complicated-0 (a b c) (a (+ 1 b) (+ 1 c)))
|
31
70
|
|
32
71
|
(def bm-complicated ()
|
@@ -57,13 +96,28 @@
|
|
57
96
|
|
58
97
|
(def rbs (name)
|
59
98
|
(let summary nil
|
60
|
-
;; (push (bm "pythag " bm-pythag 5
|
61
|
-
;; (push (bm "recursive " bm-complicated 5
|
62
|
-
|
63
|
-
|
64
|
-
|
65
|
-
|
66
|
-
|
99
|
+
;; (push (bm "pythag " bm-pythag 5 10) summary)
|
100
|
+
;; (push (bm "recursive " bm-complicated 5 1000) summary)
|
101
|
+
(push (bm "global vars " bm-add-globals 10 50000) summary)
|
102
|
+
(push (bm "0 arg times " bm-0-arg-times-call 10 50000) summary)
|
103
|
+
(push (bm "1 arg times " bm-1-arg-times-call 10 50000) summary)
|
104
|
+
(push (bm "2 arg times " bm-2-arg-times-call 10 50000) summary)
|
105
|
+
(push (bm "SYM " bm-plus-0-call 10 50000) summary)
|
106
|
+
(push (bm "SYM LEX " bm-plus-1-call 10 50000) summary)
|
107
|
+
(push (bm "SYM LEX LEX " bm-plus-2-call 10 50000) summary)
|
108
|
+
(push (bm "SYM LEX LEX LEX " bm-plus-3-call 10 50000) summary)
|
109
|
+
;; (push (bm "3 arg times" bm-3-arg-times-call 10 100000) summary)
|
110
|
+
;; (push (bm "4 arg times" bm-4-arg-times-call 10 100000) summary)
|
111
|
+
;; (push (bm "0R arg lexical-vars" bm-0R-lc-call 10 50000) summary)
|
112
|
+
;; (push (bm "1R arg lexical-vars" bm-1R-lc-call 10 50000) summary)
|
113
|
+
;; (push (bm "2R arg lexical-vars" bm-2R-lc-call 10 50000) summary)
|
114
|
+
;; (push (bm "3R arg lexical-vars" bm-3R-lc-call 10 50000) summary)
|
115
|
+
;; (push (bm "4R arg lexical-vars" bm-4R-lc-call 10 50000) summary)
|
116
|
+
;; (push (bm "0 arg lexical-vars " bm-0-lc-call 10 50000) summary)
|
117
|
+
;; (push (bm "1 arg lexical-vars " bm-1-lc-call 10 50000) summary)
|
118
|
+
;; (push (bm "2 arg lexical-vars " bm-2-lc-call 10 50000) summary)
|
119
|
+
;; (push (bm "3 arg lexical-vars " bm-3-lc-call 10 50000) summary)
|
120
|
+
;; (push (bm "4 arg lexical-vars " bm-4-lc-call 10 50000) summary)
|
121
|
+
;; (push (bm "hashing" bm-hash-fill 10 200000) summary)
|
67
122
|
;; (push (bm "pre-compile" bm-pre-compile-test 10 10000) summary)
|
68
|
-
(push (bm "hashing" bm-hash-fill 10 200000) summary)
|
69
123
|
(each s summary (p name " " s))))
|
@@ -1,21 +1,25 @@
|
|
1
1
|
(assign pp/special-forms (hash))
|
2
|
-
(assign pp/
|
2
|
+
(assign pp/syntaxes (hash))
|
3
|
+
(assign pp/newline (uniq 'newline))
|
4
|
+
(assign pp/newline/noi (uniq 'newline/noi))
|
3
5
|
|
4
|
-
(def pp/
|
6
|
+
(def pp/esc-ch (char)
|
5
7
|
(if (eq? char "\"") "\\\""
|
6
8
|
(eq? char "\~") "\\\~"
|
7
9
|
(eq? char "\\") "\\\\"
|
8
10
|
(eq? char "\n") "\\n"
|
9
11
|
char))
|
10
12
|
|
11
|
-
(def pp/
|
12
|
-
(joinstr "" (map pp/
|
13
|
+
(def pp/esc-str-literal (txt)
|
14
|
+
(joinstr "" (map pp/esc-ch (string-split txt))))
|
13
15
|
|
14
|
-
(def pp/string-piece (
|
15
|
-
(
|
16
|
-
|
16
|
+
(def pp/string-piece (pp)
|
17
|
+
(fn (thing)
|
18
|
+
(if (isa 'string thing)
|
19
|
+
(pp/esc-str-literal thing)
|
20
|
+
"\~~(pp thing)")))
|
17
21
|
|
18
|
-
(def pp/string-pieces (things) "\"~(joinstr "" (map pp/string-piece things))\"")
|
22
|
+
(def pp/string-pieces (pp things) "\"~(joinstr "" (map (pp/string-piece pp) things))\"")
|
19
23
|
|
20
24
|
(def pp/kv (hsh)
|
21
25
|
(map λk(joinstr " "
|
@@ -23,13 +27,12 @@
|
|
23
27
|
(pp hsh.,k))
|
24
28
|
(hash-keys hsh)))
|
25
29
|
|
26
|
-
(def pp/literal (thing)
|
27
|
-
(if (eq? thing '||)
|
28
|
-
""
|
29
|
-
(
|
30
|
-
"\"~(pp/
|
31
|
-
(isa 'hash thing)
|
32
|
-
"{ ~(joinstr " " (pp/kv thing)) }"
|
30
|
+
(def pp/literal (thing indent)
|
31
|
+
(if (eq? thing '||) "||"
|
32
|
+
(eq? thing pp/newline) "\n~(joinstr " " indent)"
|
33
|
+
(eq? thing pp/newline/noi) "\n~(joinstr " " (cdr indent)) "
|
34
|
+
(isa 'string thing) "\"~(pp/esc-str-literal thing)\""
|
35
|
+
(isa 'hash thing) "{ ~(joinstr " " (pp/kv thing)) }"
|
33
36
|
(inspect thing)))
|
34
37
|
|
35
38
|
(mac pp/def (name args . body)
|
@@ -37,8 +40,7 @@
|
|
37
40
|
; given name. 'args are usually (form indent), form being the
|
38
41
|
; complete form for pretty-printing, and indent being the current
|
39
42
|
; indent level.
|
40
|
-
`(do
|
41
|
-
(hash-set pp/special-forms ',name
|
43
|
+
`(do (hash-set pp/special-forms ',name
|
42
44
|
(fn ,args ,@body))
|
43
45
|
(dox-add-doc ',name
|
44
46
|
'pp/def
|
@@ -46,69 +48,120 @@
|
|
46
48
|
',args
|
47
49
|
'(pp/def ,name ,args ,@body))))
|
48
50
|
|
49
|
-
(
|
50
|
-
|
51
|
-
|
52
|
-
|
53
|
-
|
54
|
-
|
55
|
-
(pp/def
|
56
|
-
(pp/def
|
57
|
-
|
58
|
-
(
|
59
|
-
(
|
60
|
-
(
|
61
|
-
(
|
62
|
-
(
|
63
|
-
|
64
|
-
|
65
|
-
|
66
|
-
|
67
|
-
|
68
|
-
|
69
|
-
|
70
|
-
|
71
|
-
|
72
|
-
|
73
|
-
|
74
|
-
|
75
|
-
(def pp/spaces (n) (if (> n 0) " ~(pp/spaces (- n 1))" ""))
|
51
|
+
(pp/def string-pieces (pp form indent) (pp/string-pieces pp (cdr form)))
|
52
|
+
(pp/def quasiquote (pp form indent) "`~(pp (cadr form) (cons "" indent))" )
|
53
|
+
(pp/def quote (pp form indent) "'~(pp (cadr form) (cons "" indent))" )
|
54
|
+
(pp/def unquote (pp form indent) ",~(pp (cadr form) (cons "" indent))" )
|
55
|
+
(pp/def unquote-splicing (pp form indent) ",@~(pp (cadr form) (cons " " indent))")
|
56
|
+
(pp/def comment (pp form indent) "; ~(cadr form)\n")
|
57
|
+
(pp/def prefix-list (pp form indent) "~(cadr form)~(pp (caddr form))")
|
58
|
+
(pp/def brace-list (pp form indent) "{ ~(joinstr " " (map λe(pprint e (cons " " indent)) (cdr form))) }")
|
59
|
+
|
60
|
+
(def pp/unsyntax (form)
|
61
|
+
(if (pair? form)
|
62
|
+
(let syntax (hash-get pp/syntaxes (car form))
|
63
|
+
(if syntax
|
64
|
+
(sym:joinstr syntax (map pp/unsyntax (cdr form)))
|
65
|
+
(map pp/unsyntax form)))
|
66
|
+
form))
|
67
|
+
|
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 "=>" )
|
76
77
|
|
77
78
|
(def pp/dotify (form)
|
78
|
-
(if (pair?
|
79
|
-
(cons (
|
80
|
-
|
81
|
-
|
82
|
-
|
83
|
-
|
84
|
-
(
|
85
|
-
|
86
|
-
|
87
|
-
|
88
|
-
|
89
|
-
|
90
|
-
|
91
|
-
|
92
|
-
|
93
|
-
|
94
|
-
|
95
|
-
|
96
|
-
|
97
|
-
(
|
98
|
-
|
99
|
-
|
100
|
-
(
|
101
|
-
|
102
|
-
|
103
|
-
|
104
|
-
|
105
|
-
|
106
|
-
|
107
|
-
(
|
108
|
-
|
109
|
-
|
110
|
-
|
111
|
-
(
|
79
|
+
(if (pair? form)
|
80
|
+
(cons (pp/dotify:car form)
|
81
|
+
(if (pair? (cdr form))
|
82
|
+
(pp/dotify (cdr form))
|
83
|
+
(no:cdr form)
|
84
|
+
nil
|
85
|
+
(list '. (cdr form))))
|
86
|
+
form))
|
87
|
+
|
88
|
+
(def pp/split-form (form n)
|
89
|
+
(cons (firstn n form)
|
90
|
+
(map list (nthcdr n form))))
|
91
|
+
|
92
|
+
(def pp/flatly (form)
|
93
|
+
(if (pair? form)
|
94
|
+
(let special (hash-get pp/special-forms (car form))
|
95
|
+
(if special
|
96
|
+
(special pp/flatly form nil)
|
97
|
+
"(~(joinstr " " (map pp/flatly form)))"))
|
98
|
+
(pp/literal form nil)))
|
99
|
+
|
100
|
+
(def pp/breaks? (form)
|
101
|
+
(and (pair? form)
|
102
|
+
(> (len:pp/flatly form) 40)))
|
103
|
+
|
104
|
+
(def pp/breaker (form)
|
105
|
+
(if (pair? form)
|
106
|
+
(let key (car form)
|
107
|
+
(if (or (eq? 'if key)
|
108
|
+
(eq? 'cond key))
|
109
|
+
(pp/split-form form 2)
|
110
|
+
(and (hash-get macs key)
|
111
|
+
(!proper? (dox-args key)))
|
112
|
+
(pp/split-form form (list-length:dox-args key))
|
113
|
+
(pp/split-form form 2)))
|
114
|
+
form))
|
115
|
+
|
116
|
+
(def pp/break-pair (form)
|
117
|
+
(if (pair? form)
|
118
|
+
(if (hash-get pp/special-forms (car form))
|
119
|
+
form
|
120
|
+
(pp/breaks? form)
|
121
|
+
(intersperse-splicing pp/newline
|
122
|
+
(pp/breaker (map pp/break-pair form)))
|
123
|
+
form)
|
124
|
+
form))
|
125
|
+
|
126
|
+
(def pp/cleanup (str)
|
127
|
+
(string-replace "\\s+\\n" "\n" (string-replace "\\s+\\Z" "" str)))
|
128
|
+
|
129
|
+
(def pp/indent (sym indent)
|
130
|
+
(if (or (no sym) (pair? sym))
|
131
|
+
indent
|
132
|
+
(cons (string-replace "." " " " ~sym") indent)))
|
133
|
+
|
134
|
+
(def pprint (form indent)
|
135
|
+
(if (pair? form)
|
136
|
+
(let special-form (hash-get pp/special-forms (car form))
|
137
|
+
(if special-form
|
138
|
+
(special-form pp/printer form indent)
|
139
|
+
(let new-indent (pp/indent (car form) indent)
|
140
|
+
(let contents (joinstr " " (map λe(pprint e new-indent) form))
|
141
|
+
"(~contents)"))))
|
142
|
+
(pp/literal form indent)))
|
143
|
+
|
144
|
+
(def pp/with-args (wargs)
|
145
|
+
(if (> (len (pp/flatly wargs)) 40)
|
146
|
+
(intersperse-splicing pp/newline/noi
|
147
|
+
(pairs wargs))
|
148
|
+
wargs))
|
149
|
+
|
150
|
+
(pp/def with (pp form indent)
|
151
|
+
(let wargs (pp/with-args (cadr form))
|
152
|
+
(let broken (intersperse pp/newline
|
153
|
+
(map pp/break-pair
|
154
|
+
(cddr form)))
|
155
|
+
(let wbody `(,wargs ,pp/newline ,@broken)
|
156
|
+
"(with ~(joinstr " " (map λe(pprint e (cons " " indent)) wbody)))"))))
|
157
|
+
|
158
|
+
(def pp/printer (form indent)
|
159
|
+
(if (pair? form)
|
160
|
+
(pprint (pp/break-pair form) indent)
|
161
|
+
(pp/literal form indent)))
|
162
|
+
|
163
|
+
(def pp (form) (pp/cleanup:pp/printer (pp/dotify:pp/unsyntax form) nil))
|
164
|
+
;; (def pp (form) (inspect form))
|
112
165
|
|
113
166
|
(def dox-show-src (src)
|
114
167
|
; use the pretty-printer to elegantly display the given source code
|