-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmacros.shen
92 lines (74 loc) · 2.81 KB
/
macros.shen
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
(defmacro comment-macro
[! | _] -> [void]
[comment | _] -> [void])
(defmacro ???-macro
??? -> [error "not implemented"])
(defmacro function-syntax-macro
S -> [function (intern (internal.subs 2 (str S)))] where (internal.sympre? "#'" S))
(defmacro continuation-syntax-macro
S -> [freeze [(intern (internal.subs 2 (str S)))]] where (internal.sympre? "!'" S))
(defmacro value-syntax-macro
S -> [value (intern (internal.subs 2 (str S)))] where (internal.sympre? "&'" S))
(defmacro protect-syntax-macro
S -> [protect (intern (internal.subs 2 (str S)))] where (internal.sympre? "~'" S))
(defmacro thru-macro
[->> | More] -> [thru | More]
[thru] -> []
[thru X] -> X
[thru X F | Fs] -> [thru (append F [X]) | Fs] where (cons? F)
[thru X F | Fs] -> [thru [F X] | Fs])
(defmacro thru-lambda-macro
[/->> | More] -> [thru-lambda | More]
[thru-lambda | Fs] -> (let X (gensym (protect P)) [/. X [thru X | Fs]]))
(define internal.try-clauses
[where W H | More] -> [if W H (internal.try-clauses More)]
[H] -> H
_ -> (error "invalid try clause(s)."))
(defmacro try-macro
[try T H] -> [trap-error T [/. _ H]]
[try T E | Clauses] -> [trap-error T [/. E (internal.try-clauses Clauses)]])
(defmacro when-macro
[when C T] -> [if C [do T [void]] [void]])
(define internal.pairs
[] -> []
[X Y | Z] -> [[X Y] | (internal.pairs Z)])
(defmacro @d-macro
[@d | More] ->
(error "@d form requires even number of arguments")
where (not (= 0 (shen.mod (length More) 2)))
[@d | More] ->
(let D (gensym (protect D))
[let D [shen.dict (/ (length More) 2)]
(append
[do]
(map (/. P [shen.dict-> D | P]) (internal.pairs More))
[D])]))
(define internal.label
[: X T] -> [X : T ;]
X -> [X ;])
(define internal.sequent
[if [and | Ps] Q] -> (append (mapcan (function internal.label) Ps) [__] (label Q))
[if [or | Ps] Q] -> (mapcan (/. P (internal.sequent [if P Q])) Ps)
[if P [and | Qs]] -> (mapcan (/. Q (internal.sequent [if P Q])) Qs)
[if P [or | Qs]] -> (append (internal.label P) [__] (mapcan (function internal.label) Qs))
[if P Q] -> (append (internal.label P) [__] (internal.label Q))
Q -> (append [__] (internal.label Q)))
(defmacro deftype-macro
[deftype Name | Rules] ->
[datatype (concat Name -type) | (mapcan (function internal.sequent) Rules)])
(defmacro define-doc-macro
[define Name doc Doc | Rest] ->
[do
[set-doc Name Doc]
[define Name | Rest]])
(defmacro define-global-doc-macro
[define Name doc Doc { Type } Value] ->
[do
[set-doc Name Doc]
[define Name { Type } Value]])
(defmacro declare-value-macro
[declare-value Name Type] ->
(let Type' (internal.un-rcons Type)
[datatype (concat Name -type)
(protect X) : Type' ; __ [set Name (protect X)] : Type' ;
__ [value Name] : Type' ;]))