Commit | Line | Data |
---|---|---|
118269ab VS |
1 | (de MAL-= (A B) |
2 | (let (A* (MAL-type A) | |
3 | B* (MAL-type B)) | |
4 | (cond | |
5 | ((and (= A* 'map) (= B* 'map)) | |
cc494944 | 6 | (MAL-map-= (MAL-value A) (MAL-value B)) ) |
118269ab VS |
7 | ((and (memq A* '(list vector)) (memq B* '(list vector))) |
8 | (MAL-seq-= (MAL-value A) (MAL-value B)) ) | |
9 | ((= A* B*) | |
10 | (= (MAL-value A) (MAL-value B)) ) | |
11 | (T NIL) ) ) ) | |
12 | ||
cc494944 VS |
13 | (de MAL-map-= (As Bs) |
14 | (when (= (length As) (length Bs)) | |
15 | (let (As* (chunk As) Bs* (chunk Bs)) | |
16 | (catch 'result | |
17 | (while As* | |
18 | (let (A (pop 'As*) Key (MAL-value (car A)) Val (cdr A) | |
19 | B (find '((X) (= Key (MAL-value (car X)))) Bs*) ) | |
20 | (when (or (not B) (not (MAL-= Val (cdr B)))) | |
21 | (throw 'result NIL) ) ) ) | |
22 | T ) ) ) ) | |
23 | ||
118269ab VS |
24 | (de MAL-seq-= (As Bs) |
25 | (when (= (length As) (length Bs)) | |
26 | (catch 'result | |
27 | (while As | |
28 | (ifn (MAL-= (pop 'As) (pop 'Bs)) | |
29 | (throw 'result NIL) ) ) | |
cc494944 | 30 | T ) ) ) |
118269ab VS |
31 | |
32 | (de MAL-seq? (X) | |
33 | (memq (MAL-type X) '(list vector)) ) | |
34 | ||
cc494944 VS |
35 | (de MAL-f (X) |
36 | (MAL-value (if (isa '+Func X) (get X 'fn) X)) ) | |
37 | ||
30a55a91 | 38 | (de MAL-swap! @ |
cc494944 VS |
39 | (let (X (next) Fn (next) Args (rest)) |
40 | (put X 'value (apply (MAL-f Fn) Args (MAL-value X))) ) ) | |
30a55a91 | 41 | |
90670a6d VS |
42 | (de MAL-nth (Seq N) |
43 | (let (Seq* (MAL-value Seq) N* (MAL-value N)) | |
44 | (if (< N* (length Seq*)) | |
45 | (nth Seq* (inc N*) 1) | |
1809f9ba | 46 | (throw 'err (MAL-error (MAL-string "out of bounds"))) ) ) ) |
90670a6d | 47 | |
cc494944 VS |
48 | (de chunk (List) |
49 | (make | |
50 | (for (L List L (cddr L)) | |
51 | (link (cons (car L) (cadr L))) ) ) ) | |
52 | ||
5f4a0958 VS |
53 | (de join (List) |
54 | (mapcan '((X) (list (car X) (cdr X))) List) ) | |
55 | ||
56 | (de MAL-assoc @ | |
57 | (let (Map (next) Args (rest)) | |
58 | (MAL-map | |
59 | (append Args | |
60 | (join | |
61 | (filter '((X) (not (find '((Y) (MAL-= (car Y) (car X))) | |
62 | (chunk Args) ) ) ) | |
63 | (chunk (MAL-value Map)) ) ) ) ) ) ) | |
64 | ||
cc494944 VS |
65 | (de MAL-dissoc @ |
66 | (let (Map (next) Args (rest)) | |
67 | (MAL-map | |
68 | (make | |
69 | (for (L (MAL-value Map) L (cddr L)) | |
70 | (unless (find '((X) (MAL-= (car L) X)) Args) | |
71 | (link (car L) (cadr L)) ) ) ) ) ) ) | |
72 | ||
49b192dd VS |
73 | (de MAL-seq (X) |
74 | (if (or (= (MAL-type X) 'nil) (not (MAL-value X))) | |
75 | *MAL-nil | |
76 | (case (MAL-type X) | |
77 | (list X) | |
78 | (vector (MAL-list (MAL-value X))) | |
79 | (string (MAL-list (mapcar MAL-string (chop (MAL-value X))))) ) ) ) | |
80 | ||
81 | (de MAL-conj @ | |
82 | (let (Seq (next) Args (rest)) | |
83 | (if (= (MAL-type Seq) 'vector) | |
84 | (MAL-vector (append (MAL-value Seq) Args)) | |
85 | (MAL-list (append (reverse Args) (MAL-value Seq))) ) ) ) | |
86 | ||
87 | (de clone (X) | |
88 | (let X* (new (val X)) | |
89 | (maps '((C) (put X* (cdr C) (car C))) X) | |
90 | X* ) ) | |
91 | ||
3e127081 VS |
92 | (de pil-to-mal (X) |
93 | (cond | |
94 | ((not X) *MAL-nil) | |
95 | ((=T X) *MAL-true) | |
96 | ((num? X) (MAL-number X)) | |
97 | ((str? X) (MAL-string X)) | |
98 | ((sym? X) (MAL-symbol X)) | |
99 | ((lst? X) (MAL-list (mapcar pil-to-mal X))) | |
100 | (T (MAL-string (sym X))) ) ) | |
101 | ||
0e9990bc | 102 | (def '*Ns |
118269ab VS |
103 | '((+ . `(MAL-fn '((A B) (MAL-number (+ (MAL-value A) (MAL-value B)))))) |
104 | (- . `(MAL-fn '((A B) (MAL-number (- (MAL-value A) (MAL-value B)))))) | |
105 | (* . `(MAL-fn '((A B) (MAL-number (* (MAL-value A) (MAL-value B)))))) | |
106 | (/ . `(MAL-fn '((A B) (MAL-number (/ (MAL-value A) (MAL-value B)))))) | |
107 | ||
108 | (< . `(MAL-fn '((A B) (if (< (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) | |
109 | (<= . `(MAL-fn '((A B) (if (<= (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) | |
110 | (> . `(MAL-fn '((A B) (if (> (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) | |
111 | (>= . `(MAL-fn '((A B) (if (>= (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) | |
112 | ||
113 | (= . `(MAL-fn '((A B) (if (MAL-= A B) *MAL-true *MAL-false)))) | |
114 | ||
115 | (list . `(MAL-fn '(@ (MAL-list (rest))))) | |
116 | (list? . `(MAL-fn '((X) (if (= (MAL-type X) 'list) *MAL-true *MAL-false)))) | |
117 | (empty? . `(MAL-fn '((X) (if (and (MAL-seq? X) (not (MAL-value X))) *MAL-true *MAL-false)))) | |
118 | (count . `(MAL-fn '((X) (if (MAL-seq? X) (MAL-number (length (MAL-value X))) (MAL-number 0))))) | |
119 | ||
120 | (pr-str . `(MAL-fn '(@ (MAL-string (glue " " (mapcar '((X) (pr-str X T)) (rest))))))) | |
121 | (str . `(MAL-fn '(@ (MAL-string (pack (mapcar pr-str (rest))))))) | |
122 | (prn . `(MAL-fn '(@ (prinl (glue " " (mapcar '((X) (pr-str X T)) (rest)))) *MAL-nil))) | |
30a55a91 VS |
123 | (println . `(MAL-fn '(@ (prinl (glue " " (mapcar pr-str (rest)))) *MAL-nil))) |
124 | ||
125 | (read-string . `(MAL-fn '((X) (read-str (MAL-value X))))) | |
126 | (slurp . `(MAL-fn '((X) (MAL-string (in (MAL-value X) (till NIL T)))))) | |
127 | ||
128 | (atom . `(MAL-fn '((X) (MAL-atom X)))) | |
129 | (atom? . `(MAL-fn '((X) (if (= (MAL-type X) 'atom) *MAL-true *MAL-false)))) | |
130 | (deref . `(MAL-fn '((X) (MAL-value X)))) | |
131 | (reset! . `(MAL-fn '((X Value) (put X 'value Value)))) | |
32a75b86 VS |
132 | (swap! . `(MAL-fn MAL-swap!)) |
133 | ||
134 | (cons . `(MAL-fn '((X Seq) (MAL-list (cons X (MAL-value Seq)))))) | |
90670a6d VS |
135 | (concat . `(MAL-fn '(@ (MAL-list (apply append (mapcar MAL-value (rest))))))) |
136 | ||
137 | (nth . `(MAL-fn MAL-nth)) | |
138 | (first . `(MAL-fn '((X) (if (MAL-seq? X) (or (car (MAL-value X)) *MAL-nil) *MAL-nil)))) | |
cc494944 VS |
139 | (rest . `(MAL-fn '((X) (if (MAL-seq? X) (MAL-list (cdr (MAL-value X))) (MAL-list NIL))))) |
140 | ||
141 | (throw . `(MAL-fn '((X) (throw 'err (MAL-error X))))) | |
142 | ||
143 | (apply . `(MAL-fn '(@ (let (Fn (next) X (rest)) (apply (MAL-f Fn) (append (head -1 X) (MAL-value (last X)))))))) | |
144 | (map . `(MAL-fn '((Fn Seq) (MAL-list (mapcar (MAL-f Fn) (MAL-value Seq)))))) | |
145 | ||
146 | (nil? . `(MAL-fn '((X) (if (= (MAL-type X) 'nil) *MAL-true *MAL-false)))) | |
147 | (true? . `(MAL-fn '((X) (if (= (MAL-type X) 'true) *MAL-true *MAL-false)))) | |
148 | (false? . `(MAL-fn '((X) (if (= (MAL-type X) 'false) *MAL-true *MAL-false)))) | |
7cabea4f | 149 | (number? . `(MAL-fn '((X) (if (= (MAL-type X) 'number) *MAL-true *MAL-false)))) |
cc494944 VS |
150 | (symbol? . `(MAL-fn '((X) (if (= (MAL-type X) 'symbol) *MAL-true *MAL-false)))) |
151 | (keyword? . `(MAL-fn '((X) (if (= (MAL-type X) 'keyword) *MAL-true *MAL-false)))) | |
49b192dd | 152 | (string? . `(MAL-fn '((X) (if (= (MAL-type X) 'string) *MAL-true *MAL-false)))) |
cc494944 VS |
153 | (vector? . `(MAL-fn '((X) (if (= (MAL-type X) 'vector) *MAL-true *MAL-false)))) |
154 | (map? . `(MAL-fn '((X) (if (= (MAL-type X) 'map) *MAL-true *MAL-false)))) | |
155 | (sequential? . `(MAL-fn '((X) (if (MAL-seq? X) *MAL-true *MAL-false)))) | |
7cabea4f VS |
156 | (fn? . `(MAL-fn '((X) (if (or (= (MAL-type X) 'fn) (and (= (MAL-type X) 'func) (not (get X 'is-macro)))) *MAL-true *MAL-false)))) |
157 | (macro? . `(MAL-fn '((X) (if (and (= (MAL-type X) 'func) (get X 'is-macro)) *MAL-true *MAL-false)))) | |
cc494944 VS |
158 | |
159 | (symbol . `(MAL-fn '((Name) (MAL-symbol (MAL-value Name))))) | |
160 | (keyword . `(MAL-fn '((X) (if (= (MAL-type X) 'keyword) X (MAL-keyword (MAL-value X)))))) | |
161 | (vector . `(MAL-fn '(@ (MAL-vector (rest))))) | |
162 | (hash-map . `(MAL-fn '(@ (MAL-map (rest))))) | |
163 | ||
5f4a0958 | 164 | (assoc . `(MAL-fn MAL-assoc)) |
cc494944 VS |
165 | (dissoc . `(MAL-fn MAL-dissoc)) |
166 | (get . `(MAL-fn '((Map Key) (or (and (<> (MAL-type Map) 'nil) (cdr (find '((X) (MAL-= (car X) Key)) (chunk (MAL-value Map))))) *MAL-nil)))) | |
167 | (contains? . `(MAL-fn '((Map Key) (if (find '((X) (MAL-= (car X) Key)) (chunk (MAL-value Map))) *MAL-true *MAL-false)))) | |
168 | (keys . `(MAL-fn '((Map) (MAL-list (mapcar car (chunk (MAL-value Map))))))) | |
49b192dd VS |
169 | (vals . `(MAL-fn '((Map) (MAL-list (extract cdr (chunk (MAL-value Map))))))) |
170 | ||
171 | (with-meta . `(MAL-fn '((X Meta) (let X* (clone X) (put X* 'meta Meta) X*)))) | |
172 | (meta . `(MAL-fn '((X) (or (MAL-meta X) *MAL-nil)))) | |
173 | ||
174 | (readline . `(MAL-fn '((Prompt) (let Output (readline (MAL-value Prompt)) (if (=0 Output) NIL (MAL-string Output)))))) | |
175 | (time-ms . `(MAL-fn '(() (MAL-number (/ (usec) 1000))))) | |
176 | (conj . `(MAL-fn MAL-conj)) | |
3e127081 VS |
177 | (seq . `(MAL-fn MAL-seq)) |
178 | ||
179 | (pil-eval . `(MAL-fn '((Input) (pil-to-mal (run (str (MAL-value Input))))))) ) ) |