20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
..
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
(defn recurse [acc dox t & r]
(cond
(string? t)
(recurse acc [;dox t] ;r)
(or (struct? t)
(keyword? t))
(recurse [;acc t] dox ;r)
[[;(if (empty? dox) []
[{:doc (string/join dox)}])
;acc] t ;r]))
(recurse [] [] ;args))
(defmacro class [name & dfn]
(def def-map (tuple tuple (dyn *current-file*)
;(tuple/sourcemap (dyn :macro-form))))
................................................................................
(def doc-str (string/join dox))
(def body spec)
(with-dyns [*class-path*
[;(or (dyn *class-path*) []) name]]
(with-syms [$local-env $parent-env $form]
~(let [,$parent-env (or @scope (curenv))
,$local-env (,table/setproto
@{ '@name ,(mapped-val (keyword name))
'@gd-id ,(mapped-val (string export-name))
'@inherit ,(mapped-val super)
'@mode ,(mapped-val mode)
'@doc ,(if (empty? dox) nil
(mapped-val doc-str))}
,$parent-env)
,name ,$local-env]
................................................................................
(defn- member [& x]
(string/join [;(or (dyn *class-path*) [])
;x] "."))
(defmacro defclass* [id meta & r]
~(def ,id ,;meta (class ,id ,;r)))
(defmacro defclass [id & r] ~(defclass* ,id [] ,;r))
(defmacro defclass- [id & r] ~(defclass* ,id [:private] ,;r))
(defn- parse-sig [sig]
(match sig
([ty id dox & r] (string? dox))
[{:type (eval ty) :id id :doc dox}
;(parse-sig r)]
[ty id & r] [{:type (eval ty) :id id}
;(parse-sig r) ]
_ []))
(defmacro defm [id & rest]
(def (meta ret sig & body) (assemble-meta rest))
(def args (parse-sig sig))
(def md [;meta :method {:sig args :ret (eval ret)}])
(def arg-names ['me ;(map (fn [{:id id}] id) args)])
(def path (symbol (member id)))
~(def ,id ,;md (fn ,path ,arg-names ,;body)))
(defmacro defm- [id & r] ~(defm ,id :private ,;r))
(defmacro prop [id & args]
(def (meta-list ty init-val)
|
|
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
..
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
(defn recurse [acc dox t & r]
(cond
(string? t)
(recurse acc [;dox t] ;r)
(or (struct? t)
(keyword? t))
(recurse [;acc t] dox ;r)
:else [[;(if (empty? dox) []
[{:doc (string/join dox)}])
;acc] t ;r]))
(recurse [] [] ;args))
(defmacro class [name & dfn]
(def def-map (tuple tuple (dyn *current-file*)
;(tuple/sourcemap (dyn :macro-form))))
................................................................................
(def doc-str (string/join dox))
(def body spec)
(with-dyns [*class-path*
[;(or (dyn *class-path*) []) name]]
(with-syms [$local-env $parent-env $form]
~(let [,$parent-env (or @scope (curenv))
,$local-env (,table/setproto
@{ '@id ,(mapped-val (keyword name))
'@gd-id ,(mapped-val (string export-name))
'@inherit ,(mapped-val super)
'@mode ,(mapped-val mode)
'@doc ,(if (empty? dox) nil
(mapped-val doc-str))}
,$parent-env)
,name ,$local-env]
................................................................................
(defn- member [& x]
(string/join [;(or (dyn *class-path*) [])
;x] "."))
(defmacro defclass* [id meta & r]
~(def ,id ,;meta (class ,id ,;r)))
(defmacro defclass [id & r] ~(defclass* ,id [:subclass] ,;r))
(defmacro defclass- [id & r] ~(defclass* ,id [:subclass :private] ,;r))
(defn- parse-sig [sig]
(match sig
([ty id dox & r] (string? dox))
[{:type (eval ty) :id id :doc dox}
;(parse-sig r)]
[ty id & r] [{:type (eval ty) :id (tuple 'quote id)}
;(parse-sig r) ]
_ []))
(defmacro defm [id & rest]
(def (meta sig ret & body) (assemble-meta rest))
(def args (parse-sig sig))
(def md [;meta {:method {:sig args :ret (eval ret)}}])
(def arg-names ['me ;(map (fn [{:id (_ id)}] id) args)])
(def path (symbol (member id)))
~(def ,id ,;md (fn ,path ,arg-names ,;body)))
(defmacro defm- [id & r] ~(defm ,id :private ,;r))
(defmacro prop [id & args]
(def (meta-list ty init-val)
|