1use slvm::{CallFuncSig, Chunk, GVm, Interned, Value, from_i56};
2use std::cell::RefCell;
3use std::collections::HashMap;
4use std::rc::Rc;
5
6#[derive(Clone, Debug)]
7pub struct SymbolsInt {
8 pub syms: HashMap<Interned, usize>,
9 count: usize,
10}
11
12impl SymbolsInt {
13 pub fn add_sym(&mut self, sym: Interned) {
14 self.syms.insert(sym, self.count);
15 self.count += 1;
16 }
17}
18
19type Captures = Rc<RefCell<Vec<(Interned, usize, usize)>>>;
21
22#[derive(Clone, Debug)]
23pub struct Symbols {
24 pub data: Rc<RefCell<SymbolsInt>>,
25 outer: Option<Rc<RefCell<Symbols>>>,
26 pub captures: Captures,
27}
28
29impl Symbols {
30 pub fn with_outer(outer: Option<Rc<RefCell<Symbols>>>) -> Symbols {
31 let data = Rc::new(RefCell::new(SymbolsInt {
32 syms: HashMap::new(),
33 count: 1,
34 }));
35 Symbols {
36 data,
37 outer,
38 captures: Rc::new(RefCell::new(Vec::new())),
39 }
40 }
41
42 pub fn with_let(source: Rc<RefCell<Symbols>>) -> Symbols {
43 let data = Rc::new(RefCell::new(SymbolsInt {
44 syms: HashMap::new(),
45 count: source.borrow().data.borrow().count,
46 }));
47 {
48 let mut datad = data.borrow_mut();
49 for (key, val) in source.borrow().data.borrow().syms.iter() {
50 datad.syms.insert(*key, *val);
51 }
52 }
53 Symbols {
54 data,
55 outer: source.borrow().outer.clone(),
56 captures: source.borrow().captures.clone(),
57 }
58 }
59
60 pub fn is_empty(&self) -> bool {
61 self.data.borrow().syms.is_empty()
62 }
63
64 pub fn regs_count(&self) -> usize {
65 self.data.borrow().count
66 }
67
68 pub fn contains_symbol(&self, key: Interned) -> bool {
69 self.data.borrow().syms.contains_key(&key)
70 }
71
72 #[allow(clippy::assigning_clones)] pub fn can_capture(&self, key: Interned) -> bool {
74 let mut loop_outer = self.outer.clone();
75 while let Some(outer) = loop_outer {
76 let outer = outer.borrow();
77 if outer.contains_symbol(key) {
78 return true;
79 }
80 loop_outer = outer.outer.clone();
81 }
82 false
83 }
84
85 pub fn get_capture_binding(&self, key: Interned) -> Option<usize> {
86 for cap in &*self.captures.borrow() {
87 if cap.0 == key {
88 return Some(cap.2);
89 }
90 }
91 None
92 }
93
94 pub fn get(&self, key: Interned) -> Option<usize> {
95 self.data.borrow().syms.get(&key).copied()
96 }
97
98 pub fn clear(&mut self) {
99 self.data.borrow_mut().syms.clear();
100 }
101
102 pub fn reserve_reg(&mut self) -> usize {
103 let mut data = self.data.borrow_mut();
104 let count = data.count;
105 data.count += 1;
106 count
107 }
108
109 pub fn insert(&mut self, key: Interned) -> usize {
110 let mut data = self.data.borrow_mut();
111 let count = data.count;
112 data.syms.insert(key, count);
113 data.count += 1;
114 count
115 }
116
117 pub fn insert_reserved(&mut self, key: Interned, register: usize) {
118 let mut data = self.data.borrow_mut();
119 data.syms.insert(key, register);
120 }
121
122 pub fn insert_capture(&self, _vm: &mut SloshVm, key: Interned) -> Option<usize> {
123 let data_d = self.data.borrow();
124 if let Some(idx) = data_d.syms.get(&key) {
125 Some(*idx)
126 } else {
127 if let Some(outer) = &self.outer {
128 drop(data_d);
129 if let Some(outer_idx) = outer.borrow().insert_capture(_vm, key) {
131 let mut data = self.data.borrow_mut();
132 let count = data.count;
133 data.syms.insert(key, count);
134 data.count += 1;
135 self.captures.borrow_mut().push((key, count, outer_idx));
136 return Some(count);
137 }
138 }
139 None
140 }
141 }
142
143 pub fn len_captures(&self) -> usize {
144 self.captures.borrow().len()
145 }
146}
147
148pub struct Specials {
149 pub def: Interned,
150 pub set: Interned,
151 pub do_: Interned,
152 pub fn_: Interned,
153 pub mac_: Interned,
154 pub if_: Interned,
155 pub add: Interned,
156 pub sub: Interned,
157 pub mul: Interned,
158 pub div: Interned,
159 pub inc: Interned,
160 pub dec: Interned,
161 pub list: Interned,
162 pub list_append: Interned,
163 pub cons: Interned,
164 pub car: Interned,
165 pub cdr: Interned,
166 pub xar: Interned,
167 pub xdr: Interned,
168 pub make_hash: Interned,
169 pub vec: Interned,
170 pub make_vec: Interned,
171 pub vec_pop: Interned,
172 pub vec_push: Interned,
173 pub quote: Interned,
174 pub backquote: Interned,
175 pub recur: Interned,
176 pub this_fn: Interned,
177 pub numeq: Interned,
178 pub numlt: Interned,
179 pub numlte: Interned,
180 pub numgt: Interned,
181 pub numgte: Interned,
182 pub eq: Interned,
183 pub equal: Interned,
184 pub type_: Interned,
185 pub not: Interned,
186 pub and: Interned,
187 pub or: Interned,
188 pub err: Interned,
189 pub len: Interned,
190 pub clear: Interned,
191 pub str_: Interned,
192 pub let_: Interned,
193 pub let_while: Interned,
194 pub call_cc: Interned,
195 pub defer: Interned,
196 pub on_error: Interned,
197 pub while_: Interned,
198 pub doc_string: Interned,
199 pub get: Interned,
200 pub mk_err: Interned,
201 pub is_err: Interned,
202 pub is_ok: Interned,
203 pub ret: Interned,
204 pub ns: Interned,
205 pub with_ns: Interned,
206 pub import: Interned,
207 pub load: Interned,
208 pub comp_time: Interned,
209
210 pub rest: Interned,
211 pub optional: Interned,
212 pub scratch: Interned,
213 pub colon: Interned,
214 pub root: Interned,
215}
216
217impl Specials {
218 pub fn new(vm: &mut SloshVm) -> Self {
219 Self {
220 def: add_special(vm, "def", r#"Usage: (def symbol doc_string? expression) -> expression
221
222Adds an expression to the current namespace. Return the expression that was defined.
223Symbol is not evaluated. Can take an option doc string (docstrings can only be
224set on namespaced (global) symbols).
225
226Section: core
227
228Example:
229(def test-do-one nil)
230(def test-do-two nil)
231(def test-do-three (do (set! test-do-one "One")(set! test-do-two "Two")"Three"))
232(test::assert-equal "One" test-do-one)
233(test::assert-equal "Two" test-do-two)
234(test::assert-equal "Three" test-do-three)
235(let (test-do-one nil)
236 ; Add this to the let's scope (shadow the outer test-do-two).
237 (test::assert-equal "Default" (def test-do-four "Default"))
238 ; set the currently scoped value.
239 (set! test-do-one "1111")
240 (set! test-do-two "2222")
241 (test::assert-equal "1111" test-do-one)
242 (test::assert-equal "2222" test-do-two)
243 (test::assert-equal "Default" test-do-four))
244; Original outer scope not changed.
245(test::assert-equal "One" test-do-one)
246(test::assert-equal "Default" test-do-four)"#),
247 set: add_special(vm, "set!", r#"Usage: (set! symbol expression) -> expression
248
249Sets an existing expression in the current scope(s). Return the expression that was set.
250Symbol is not evaluated.
251
252Set will set the first binding it finds starting in the current scope and then
253trying enclosing scopes until exhausted.
254
255Section: core
256
257Example:
258(def test-do-one nil)
259(def test-do-two nil)
260(def test-do-three (do (set! test-do-one "One")(set! test-do-two "Two")"Three"))
261(test::assert-equal "One" test-do-one)
262(test::assert-equal "Two" test-do-two)
263(test::assert-equal "Three" test-do-three)
264(let (test-do-one nil)
265 ; set the currently scoped value.
266 (test::assert-equal "1111" (set! test-do-one "1111"))
267 (test::assert-equal "1111" test-do-one))
268; Original outer scope not changed.
269(test::assert-equal "One" test-do-one)"#),
270 do_: add_special(vm, "do", r#"Usage: (do exp0 ... expN) -> expN
271
272Evaluate each form and return the last.
273
274Section: core
275
276Example:
277(def test-do-one nil)
278(def test-do-two nil)
279(def test-do-three (do (set! test-do-one "One") (set! test-do-two "Two") "Three"))
280(test::assert-equal "One" test-do-one)
281(test::assert-equal "Two" test-do-two)
282(test::assert-equal "Three" test-do-three)
283"#),
284 fn_: add_special(vm, "fn", "Usage: (fn (param*) expr*) -> exprN
285
286Create a function (lambda).
287
288Section: core
289
290Example:
291(def test-fn1 nil)
292(def test-fn2 nil)
293(def test-fn3 nil)
294(def test-fn-empty ((fn () nil)))
295(test::assert-false test-fn-empty)
296((fn () (set! test-fn1 1)))
297(test::assert-equal 1 test-fn1)
298((fn () (set! test-fn1 10)(set! test-fn2 2)))
299(test::assert-equal 10 test-fn1)
300(test::assert-equal 2 test-fn2)
301((fn () (set! test-fn1 11)(set! test-fn2 20)(set! test-fn3 3)))
302(test::assert-equal 11 test-fn1)
303(test::assert-equal 20 test-fn2)
304(test::assert-equal 3 test-fn3)
305(test::assert-equal 63 ((fn (x y z) (set! test-fn1 x)(set! test-fn2 y)(set! test-fn3 z)(+ x y z)) 12 21 30))
306(test::assert-equal 12 test-fn1)
307(test::assert-equal 21 test-fn2)
308(test::assert-equal 30 test-fn3)
309"),
310 mac_: add_special(vm, "macro", "Usage: (macro (args) `(apply + ,@args))
311
312Define an anonymous macro.
313
314Section: core
315
316Example:
317(def test-macro1 nil)
318(def test-macro2 nil)
319(def test-macro-empty (macro () nil))
320(test::assert-false (test-macro-empty))
321(def test-mac nil)
322(def mac-var 2)
323(let (mac-var 3)
324 (set! test-mac (macro (x) (set! test-macro2 100) (test::assert-equal 3 mac-var) (* mac-var x))))
325(set! test-macro1 (test-mac 10))
326(test::assert-equal 30 test-macro1)
327(test::assert-equal 100 test-macro2)"),
328 if_: add_special(vm, "if", r#"Usage: (if p1 a1 p2 a2 ... pn an?) -> [evaled form result]
329
330If conditional. Will evaluate p1 and if true (i.e. not nil or false) then
331return the evaluation of a1, if falsey(i.e. nil or false) evaluate p2 and so on.
332On an odd number of arguments (an is missing) then evaluate and return pn.
333Return false(#f) if no predicate is true. This degenerates into the traditional
334(if predicate then-form else-form).
335NOTE: Both nil and false(#f) are 'falsey' for the purposes of if.
336
337Section: conditional
338
339Example:
340(def test-if-one
341 (if #t "ONE TRUE" "ONE FALSE"))
342(def test-if-two
343 (if nil "TWO TRUE" "TWO FALSE"))
344(def test-if-three
345 (if #f "THREE TRUE" "THREE FALSE"))
346(test::assert-equal "ONE TRUE" test-if-one)
347(test::assert-equal "TWO FALSE" test-if-two)
348(test::assert-equal "THREE FALSE" test-if-three)
349
350(def test-if-one2
351 (if #t "ONE2 TRUE"))
352(def test-if-two2
353 (if nil "TWO2 TRUE"))
354(def test-if-three2
355 (if #f "THREE2 TRUE"))
356(test::assert-equal "ONE2 TRUE" test-if-one2)
357(test::assert-equal #f test-if-two2)
358(test::assert-equal #f test-if-three2)
359
360(def test-if-one2
361 (if nil "ONE FALSE" #t "ONE TRUE" #t "ONE TRUE2"))
362(def test-if-two2
363 (if nil "TWO TRUE" #f "TWO FALSE" #t "TWO TRUE2"))
364(def test-if-three2
365 (if #f "THREE TRUE" nil "THREE FALSE" "THREE DEFAULT"))
366(test::assert-equal "ONE TRUE" test-if-one2)
367(test::assert-equal "TWO TRUE2" test-if-two2)
368(test::assert-equal "THREE DEFAULT" test-if-three2)
369(test::assert-equal nil (if nil))
370(test::assert-equal #f (if nil #t nil #t nil #t))"#),
371 add: add_special(vm, "+", r#"Usage: (+ number*)
372
373Add a sequence of numbers. (+) will return 0.
374
375Section: math
376
377Example:
378(test::assert-equal 0 (+))
379(test::assert-equal 5 (+ 5))
380(test::assert-equal 10 (+ 5 5))
381(test::assert-equal 6 (+ 1 5))
382(test::assert-equal 6.5 (+ 1 5.5))
383(test::assert-equal 7 (+ 1 2 4))
384(test::assert-error (+ 1 2 4 "5"))"#),
385 sub: add_special(vm, "-", r#"Usage: (- number+)
386
387Subtract a sequence of numbers. Requires at least one number (negate if only one number).
388
389Section: math
390
391Example:
392(test::assert-error (- 5 "2"))
393(test::assert-equal -5 (- 5))
394(test::assert-equal -5.0 (- 5.0))
395(test::assert-equal -4 (- 1 5))
396(test::assert-equal -4.5 (- 1 5.5))
397(test::assert-equal 4 (- 10 2 4))
398(test::assert-equal 4.5 (- 10 2 3.5))
399"#),
400 mul: add_special(vm, "*", r#"Usage: (* number*)
401
402Multiply a sequence of numbers. (*) will return 1.
403
404Section: math
405
406Example:
407(test::assert-equal 1 (*))
408(test::assert-equal 5 (* 5))
409(test::assert-equal 5 (* 1 5))
410(test::assert-equal 5.0 (* 1.0 5))
411(test::assert-equal 7.5 (* 1.5 5))
412(test::assert-equal 7.5 (* 1.5 5.0))
413(test::assert-equal 15 (* 3 5))
414(test::assert-equal 8 (* 1 2 4))
415(test::assert-equal 16 (* 2 2 4))
416(test::assert-equal 16.0 (* 2 2.0 4))
417(test::assert-equal 16.0 (* 2.0 2.0 4.0))
418(test::assert-equal 54.9999999999999 (* 100 0.55))
419(test::assert-error (* 1 2 4 "5"))
420"#),
421 div: add_special(vm, "/", r#"Usage: (/ number+)
422
423Divide a sequence of numbers. Requires at least two numbers.
424
425Section: math
426Example:
427(test::assert-equal 5 (/ 50 10))
428(test::assert-equal 5 (/ 50.0 10.0))
429(test::assert-equal 0 (/ 1 5))
430(test::assert-equal .2 (/ 1.0 5))
431(test::assert-equal .2 (/ 1.0 5.0))
432(test::assert-equal 5.5 (/ 5.5 1))
433(test::assert-equal 2 (/ 16 2 4))
434(test::assert-equal 5 (/ 100 2 5 2))
435(test::assert-error (/))
436(test::assert-error (/ 1))
437(test::assert-error (/ 1 0))
438(test::assert-error (/ 10 5 0))
439(test::assert-error (/ 10 "5" 2))
440"#),
441 inc: add_special(vm, "inc!", r#"Usage: (inc! symbol [number]) -> new value
442
443Increment the value in symbol by one or the optional number
444
445Section: core
446
447Example:
448(def *inc-test* 1)
449(test::assert-equal 2 (inc! *inc-test*))
450(test::assert-equal 2 *inc-test*)
451(test::assert-equal 5 (inc! *inc-test* 3))
452(test::assert-equal 5 *inc-test*)
453(let (inc-test 1)
454 (test::assert-equal 2 (inc! inc-test))
455 (test::assert-equal 2 inc-test)
456 (test::assert-equal 5 (inc! inc-test 3))
457 (test::assert-equal 5 inc-test))"#),
458 dec: add_special(vm, "dec!", r#"Usage: (dec! symbol [number]) -> new value
459
460Decrement the value in symbol by one or the optional number
461
462Section: core
463
464Example:
465(def *dec-test* 5)
466(test::assert-equal 4 (dec! *dec-test*))
467(test::assert-equal 4 *dec-test*)
468(test::assert-equal 1 (dec! *dec-test* 3))
469(test::assert-equal 1 *dec-test*)
470(let (dec-test 5)
471 (test::assert-equal 4 (dec! dec-test))
472 (test::assert-equal 4 dec-test)
473 (test::assert-equal 1 (dec! dec-test 3))
474 (test::assert-equal 1 dec-test))"#),
475 list: add_special(vm, "list", "
476Usage: (list item0 item1 .. itemN)
477
478Create a proper list from pairs with items 0 - N.
479
480Section: pair
481
482Example:
483(test::assert-equal '(1 2 3) (list 1 2 3))
484(test::assert-equal '() (list))
485"),
486 list_append: add_special(vm, "list-append", r#"Usage: (list-append list item)
487
488If last parameter is a list it will be appened to the first list, otherwise
489adds item as pair.
490
491Section: pair
492
493Example:
494(test::assert-equal (list-append (list 1 2 3) (list 1)) (list 1 2 3 1))
495;; demonstrates that appending two lists is different than appending a non-list value
496(test::assert-not-equal (list-append (list 1 2 3) (list 1)) (list-append (list 1 2 3) 1))
497(test::assert-equal (list 1 2 3 4 5 6 7 8 9) (list-append (list 1 2 3) (list 4 5 6) (list 7 8 9)))
498(test::assert-equal (list-append '(:a :b :c) '(:d :e :f) '() '(:g)) '(:a :b :c :d :e :f :g))
499;; TODO PC unrepresentable?
500(test::assert-equal (list-append '(1 2 3) 4) '(1 2 3 . 4))
501(def lst '(:a :b :c))
502(test::assert-equal (list-append lst (list :d)) (list :a :b :c :d))
503(test::assert-equal lst '(:a :b :c))
504(test::assert-equal (list-append) nil)
505(test::assert-equal (list-append :a) :a)
506"#),
507 cons: add_special(vm, "cons", r#"Usage: (cons item collection)
508
509Prepends item to collection, forms a pair.
510
511Section: pair
512
513Example:
514(test::assert-equal '(1 2 3) (cons 1 (list 2 3)))
515(test::assert-equal (cons 1 (cons 2 (cons 3 '()))) '(1 2 3))
516(test::assert-equal (cons 1 2) (1 . 2))
517(test::assert-equal (cons 1 nil) (1))
518(test::assert-equal (cons nil 2) (nil . 3))
519(test::assert-equal (cons nil nil) (nil))
520(test::assert-equal (cons 1 (cons 2 (cons 3 (cons 4 nil)))) '(1 2 3 4))
521(test::assert-equal (cons 1 2) (1 . 2))
522(test::assert-equal (cons 1 '(2 3 4)) (1 2 3 4))
523"#),
524 car: add_special(vm, "car", "Usage: (car pair)
525
526Return the car (first item) from a pair. If used on a proper list this will be the first element.
527
528Section: pair
529
530Example:
531(def tst-pairs-two (list 'x 'y 'z))
532(test::assert-equal 'x (car tst-pairs-two))
533(test::assert-equal 10 (car '(10)))
534(test::assert-equal 9 (car '(9 11 13)))"),
535 cdr: add_special(vm, "cdr", "Usage: (cdr pair)
536
537Return the cdr (second item) from a pair. If used on a proper list this will be the list minus the first element.
538
539Section: pair
540
541Example:
542(def tst-pairs-three (list 'x 'y 'z))
543(test::assert-equal '(y z) (cdr tst-pairs-three))
544(test::assert-equal nil (cdr '(10)))
545(test::assert-equal '(13) (cdr '(9 13)))
546(test::assert-equal '(11 13) (cdr '(9 11 13)))"),
547 xar: add_special(
548 vm,
549 "xar!",
550 "
551Usage: (xar! pair expression)
552
553Destructive form that replaces the car (first item) in a pair with a new expression.
554
555If used on a proper list will replace the first item. Can be used on nil to
556create a pair (expression . nil).
557
558Section: pair
559
560Example:
561(def tst-pairs-three (list 'x 'y 'z))
562(test::assert-equal '(x y z) tst-pairs-three)
563(test::assert-equal '(s y z) (xar! tst-pairs-three 's))
564(test::assert-equal '(s y z) tst-pairs-three)
565(def tst-pairs-four (list 't))
566(test::assert-equal '(y) (xar! tst-pairs-four 'y))
567(test::assert-equal '(y) tst-pairs-four)",
568 ),
569 xdr: add_special(
570 vm,
571 "xdr!",
572 "Usage: (xdr! pair expression)
573
574Destructive form that replaces the cdr (second item) in a pair with a new expression.
575
576If used on a proper list will replace everything after the first item.
577Can be used on nil to create a pair (nil . expression).
578
579Section: pair
580
581Example:
582(def tst-pairs-five (list 'a 'b 'c))
583(test::assert-equal '(a b c) tst-pairs-five)
584(test::assert-equal '(a y z) (xdr! tst-pairs-five '(y z)))
585(test::assert-equal '(a y z) tst-pairs-five)
586(def tst-pairs-six (list 'v))
587(test::assert-equal (list 'v) tst-pairs-six)
588(test::assert-equal '(v . v) (xdr! tst-pairs-six 'v))
589(test::assert-equal '(v . v) tst-pairs-six)",
590 ),
591 make_hash: add_special(
592 vm,
593 "make-hash",
594 "Usage: (make-hash associations?)
595
596Make a new hash map.
597
598If associations is provided (makes an empty map if not) then it is a list of
599pairs (key . value) that populate the initial map. Neither key nor value in the
600associations will be evaluated.
601
602Section: hashmap
603
604",
605 ),
606 vec: add_special(
607 vm,
608 "vec",
609 "Usage: (vec item1 item2 .. itemN)
610
611Make a new vector with items.
612
613Section: vector
614
615Example:
616(test::assert-equal [] (vec))
617(test::assert-equal [1 2 3] (vec 1 2 3))
618",
619 ),
620 make_vec: add_special(
621 vm,
622 "make-vec",
623 "Usage: (make-vec capacity default)
624
625Make a new vector with capacity and default item(s).
626
627Section: vector
628
629Example:
630(test::assert-equal [] (make-vec))
631(test::assert-equal ['x 'x 'x] (make-vec 3 'x))
632(test::assert-equal [nil nil nil nil nil] (make-vec 5 nil))
633(test::assert-equal [] (make-vec 5))
634",
635 ),
636 vec_push: add_special(
637 vm,
638 "vec-push!",
639 "Usage: (vec-push! vector object) -> vector
640
641Pushes the provided object onto the end of the vector. This is destructive!
642
643Section: vector
644
645Example:
646(def test-push-vec (vec))
647(test::assert-equal [1] (vec-push! test-push-vec 1))
648(test::assert-equal [1] test-push-vec)
649(test::assert-equal [1 2] (vec-push! test-push-vec 2))
650(test::assert-equal [1 2] test-push-vec)
651(test::assert-equal [1 2 3] (vec-push! test-push-vec 3))
652(test::assert-equal [1 2 3] test-push-vec)
653",
654 ),
655 vec_pop: add_special(
656 vm,
657 "vec-pop!",
658 "Usage: (vec-pop! vector) -> object
659
660Pops the last object off of the end of the vector. This is destructive!
661
662Section: vector
663
664Example:
665(def test-pop-vec (vec 1 2 3))
666(test::assert-equal 3 (vec-pop! test-pop-vec))
667(test::assert-equal [1 2] test-pop-vec)
668(test::assert-equal 2 (vec-pop! test-pop-vec))
669(test::assert-equal [1] test-pop-vec)
670(test::assert-equal 1 (vec-pop! test-pop-vec))
671(test::assert-equal [] test-pop-vec)
672",
673 ),
674 quote: add_special(
675 vm,
676 "quote",
677 "Usage: 'expression -> expression
678
679Return expression without evaluation.
680The reader macro 'expression will expand to (quote expression).
681
682Section: core
683
684Example:
685(test::assert-equal (list 1 2 3) (quote (1 2 3)))
686(test::assert-equal (list 1 2 3) '(1 2 3))
687(test::assert-equal '(1 2 3) (quote (1 2 3)))",
688 ),
689 backquote: add_special(
690 vm,
691 "back-quote",
692 "Usage: `expression -> expression
693
694Return expression without evaluation.
695Always use the ` reader macro or expansion will not work
696(i.e. (back-quote expression) will not do , expansion).
697
698Backquote (unlike quote) allows for symbol/form evaluation using , or ,@.
699
700Section: core
701
702Example:
703(test::assert-equal (list 1 2 3) `(1 2 3))
704(test::assert-equal `(1 2 3) '(1 2 3))
705(def test-bquote-one 1)
706(def test-bquote-list '(1 2 3))
707(test::assert-equal (list 1 2 3) `(~test-bquote-one 2 3))
708(test::assert-equal (list 1 2 3) `(~@test-bquote-list))
709 ",
710 ),
711 recur: add_special(
712 vm,
713 "recur",
714 "Usage: (recur &rest)
715
716Recursively call the enclosing function with the given parameters. Recur uses
717tail call optimization and must be in the tail position or it is an error. For
718a named function it would be equivalent to a normal recursive call in a tail
719position but it requires a tail position and does not need a name (a normal
720recursive call would work in a non-tail position but could blow the stack if
721it is to deep- unlike a recur or tail position recursive call).
722NOTE: potential footgun, the let macro expands to a lambda (fn) and a recur used
723inside the let would bind with the let not the enclosing lambda (this would
724apply to any macro that also expands to a lambda- this is by design with the
725loop macro but would be unexpected with let).
726
727Section: core
728
729Example:
730(def tot 0)
731(loop (idx) (3) (do
732 (set! tot (+ tot 1))
733 (if (> idx 1) (recur (- idx 1)))))
734(test::assert-equal 3 tot)
735(set! tot 0)
736((fn (idx) (do
737 (set! tot (+ tot 1))
738 (if (> idx 1) (recur (- idx 1)))))5)
739(test::assert-equal 5 tot)",
740 ),
741 this_fn: add_special(vm, "this-fn", ""),
742 numeq: add_special(vm, "==", r#"Usage: (== val0 ... valN)
743
744Equals. Works for numeric types (int, float).
745
746Section: conditional
747
748Example:
749(test::assert-false (== 1 2))
750(test::assert-true (== 2 2))
751(test::assert-true (== 2 2 2))
752(test::assert-false (== 3 2 2))
753(test::assert-false (== 3.0 2.0))
754(test::assert-true (== 2.0 2.0))
755(test::assert-true (== 2.0 2.0 2.0))
756(test::assert-false (== 3.0 2.0 2.0))
757(test::assert-false (== 2.1 2.0 3.0))
758(test::assert-false (== 2 1))
759(test::assert-false (== 3 2 1))
760(test::assert-false (== 1.1 1.0))
761(test::assert-true (== 1.1 1.1))
762(test::assert-false (== 3 2 3))
763"#),
764 numlt: add_special(vm, "<", r#"Usage: (< val0 ... valN)
765
766Less than. Works for int, float or string.
767
768Section: conditional
769
770Example:
771(test::assert-true (< 1 2))
772(test::assert-true (< 1 2 3 4))
773(test::assert-false (< 2 2))
774(test::assert-false (< 2 2 2))
775(test::assert-false (< 2 2 3))
776(test::assert-true (< 1.0 2.0))
777(test::assert-false (< 2.0 2.0))
778(test::assert-false (< 2.0 2.0 2.0))
779(test::assert-false (< 2.0 2.0 3.0))
780(test::assert-false (< 2.1 2.0 3.0))
781(test::assert-false (< 2 1))
782(test::assert-false (< 3 2 3))
783(test::assert-true (< 1.0 1.1 ))
784(test::assert-true (< 1.0 1.01 ))
785(test::assert-true (< 1.0 1.001 ))
786(test::assert-true (< 1.0 1.0001 ))
787(test::assert-true (< 1.0 1.00001 ))
788(test::assert-true (< 1.0 1.000001 ))
789(test::assert-true (< 1.0 1.0000001 ))
790(test::assert-false (< 1.0 1.00000000000001 ))
791"#),
792 numlte: add_special(vm, "<=", r#"Usage: (<= val0 ... valN)
793
794Less than or equal. Works for int, float or string.
795
796Section: conditional
797
798Example:
799(test::assert-true (<= 1 2))
800(test::assert-true (<= 2 2))
801(test::assert-true (<= 2 2 2))
802(test::assert-true (<= 2 2 3))
803(test::assert-true (<= 1.0 2.0))
804(test::assert-true (<= 2.0 2.0))
805(test::assert-true (<= 2.0 2.0 2.0))
806(test::assert-true (<= 2.0 2.0 3.0))
807(test::assert-false (<= 2.1 2.0 3.0))
808(test::assert-false (<= 2 1))
809(test::assert-false (<= 3 2 3))
810(test::assert-true (<= 1.00000000000001 1.0000000000001 ))
811(test::assert-true (<= 10.0000000000001 10.000000000001))
812(test::assert-true (<= 100.000000000001 100.00000000001))
813(test::assert-true (<= 1000.000000000001 1000.00000000001))
814"#),
815 numgt: add_special(vm, ">", r#"Usage: (> val0 ... valN)
816
817Greater than. Works for int, float or string.
818
819Section: conditional
820
821Example:
822(test::assert-false (> 1 2))
823(test::assert-false (> 2 2))
824(test::assert-false (> 2 2 2))
825(test::assert-false (> 3 2 2))
826(test::assert-true (> 3.0 2.0))
827(test::assert-false (> 2.0 2.0))
828(test::assert-false (> 2.0 2.0 2.0))
829(test::assert-false (> 3.0 2.0 2.0))
830(test::assert-false (> 2.1 2.0 3.0))
831(test::assert-true (> 2 1))
832(test::assert-true (> 3 2 1))
833(test::assert-true (> 1.1 1.0))
834(test::assert-false (> 3 2 3))
835(test::assert-true (> 1.001 1.0))
836(test::assert-true (> 1.0000001 1.0))
837(test::assert-false (> 1.00000000000001 1.0))
838"#),
839 numgte: add_special(vm, ">=", r#"Usage: (>= val0 ... valN)
840
841Greater than or equal. Works for int, float or string.
842
843Section: conditional
844
845Example:
846(test::assert-false (>= 1 2))
847(test::assert-true (>= 2 2))
848(test::assert-true (>= 2 2 2))
849(test::assert-true (>= 3 2 2))
850(test::assert-true (>= 3.0 2.0))
851(test::assert-true (>= 2.0 2.0))
852(test::assert-true (>= 2.0 2.0 2.0))
853(test::assert-true (>= 3.0 2.0 2.0))
854(test::assert-false (>= 2.1 2.0 3.0))
855(test::assert-true (>= 2 1))
856(test::assert-true (>= 1.1 1.0))
857(test::assert-false (>= 3 2 3))
858(test::assert-true (>= 1.0000000000001 1.00000000000001))
859(test::assert-true (>= 10.000000000001 10.0000000000001))
860(test::assert-true (>= 100.00000000001 100.000000000001))
861(test::assert-true (>= 1000.00000000001 1000.000000000001))
862"#),
863 eq: add_special(vm, "identical?", ""),
864 equal: add_special(vm, "=", r#"Usage: (= val0 val1)
865
866Test equality, works for most value types where it makes sense, not just primitives.
867
868Section: core
869
870Example:
871(test::assert-false (= "aab" "aaa"))
872(test::assert-true (= "aaa" "aaa"))
873(test::assert-true (= "aaa" "aaa" "aaa"))
874(test::assert-false (= "aaa" "aaaa" "aaa"))
875(test::assert-false (= "ccc" "aab" "aaa"))
876(test::assert-false (= "aaa" "aab"))
877(test::assert-true (= (get-error (/ 1 0)) (get-error (/ 1 0))))
878"#),
879 type_: add_special(vm, "type", ""),
880 not: add_special(vm, "not", "Usage: (not expression)
881
882Return true(#t) if expression is nil, false(#f) otherwise.
883
884Section: conditional
885
886Example:
887(test::assert-true (not nil))
888(test::assert-false (not 10))
889(test::assert-false (not #t))
890(test::assert-false (not (+ 1 2 3)))"),
891 and: add_special(vm, "and", r#"Usage: (and exp0 ... expN) -> [false(#f) or expN result]
892
893Evaluates each form until one produces nil or false(#f), produces false(#f) if
894any form is nil/#f or the result of the last expression.
895
896The and form will stop evaluating when the first expression produces nil/#f.
897
898Section: conditional
899
900Example:
901(test::assert-equal #f (and nil (err "and- can not happen")))
902(test::assert-equal #f (and #f (err "and- can not happen")))
903(test::assert-equal "and- done" (and #t "and- done"))
904(test::assert-equal "and- done" (and #t #t "and- done"))
905(test::assert-equal 6 (and #t #t (+ 1 2 3)))
906(test::assert-equal 6 (and (/ 10 5) (* 5 2) (+ 1 2 3)))"#),
907 or: add_special(vm, "or", r#"Usage: (or exp0 ... expN) -> [false(#f) or first non nil expression]
908
909Evaluates each form until one produces a non-nil/non-false result, produces #f
910if all expressions are 'falsey'.
911
912The or form will stop evaluating when the first expression produces non-nil/false.
913
914Section: conditional
915
916Example:
917(test::assert-true (or nil nil #t (err "and- can not happen")))
918(test::assert-true (or #f nil #t (err "and- can not happen")))
919(test::assert-true (or #f #f #t (err "and- can not happen")))
920(test::assert-equal #f (or nil nil nil))
921(test::assert-equal #f (or #f nil nil))
922(test::assert-equal #f (or #f nil #f))
923(test::assert-equal #f (or #f #f #f))
924(test::assert-equal "or- done" (or nil "or- done"))
925(test::assert-equal "or- done" (or nil nil "or- done"))
926(test::assert-equal 6 (or nil nil (+ 1 2 3)))
927(test::assert-equal 2 (or (/ 10 5) (* 5 2) (+ 1 2 3)))"#),
928 len: add_special(
929 vm,
930 "len",
931 r#"Usage: (len expression) -> int
932
933Return length of supplied expression. The length of an atom is 1.
934
935Section: core
936
937Example:
938(test::assert-equal 0 (len nil))
939(test::assert-equal 5 (len "12345"))
940; Note the unicode symbol is only one char even though it is more then one byte.
941(test::assert-equal 6 (len "12345Σ"))
942(test::assert-equal 3 (len '(1 2 3)))
943(test::assert-equal 3 (len [1 2 3]))
944(test::assert-equal 3 (len (list 1 2 3)))
945(test::assert-equal 3 (len (vec 1 2 3)))
946(test::assert-equal 1 (len 100))
947(test::assert-equal 1 (len 100.0))
948(test::assert-equal 1 (len \tab))
949"#,
950 ),
951 clear: add_special(
952 vm,
953 "clear!",
954 "Usage: (clear! container)
955
956Clears a container (vector, hash-map, string). This is destructive!
957
958Section: collection
959
960Example:
961(def test-clear-vec (vec 1 2 3))
962(test::assert-false (empty? test-clear-vec))
963(clear! test-clear-vec)
964(test::assert-true (empty? test-clear-vec))
965",
966 ),
967 str_: add_special(vm, "str", r#"Usage: (str arg0 ... argN) -> string
968
969Make a new string with its arguments.
970
971Arguments will be turned into strings. If an argument is a process then the
972output of the process will be captured and put into the string.
973
974Section: string
975
976Example:
977(test::assert-equal "stringsome" (str "string" "some"))
978(test::assert-equal "string" (str "string" ""))
979(test::assert-equal "string 50" (str "string" " " 50))
980"#),
981 let_: add_special(vm, "let", r#"Usage: (let vals &rest let-body)
982
983Takes list, vals, of form ((binding0 sexp0) (binding1 sexp1) ...) and evaluates
984let-body with all values of binding bound to the result of the evaluation of
985sexp.
986
987Section: core
988
989Example:
990(def test-do-one "One1")
991(def test-do-two "Two1")
992(def test-do-three (let (test-do-one "One") (set! test-do-two "Two")(test::assert-equal "One" test-do-one)"Three"))
993(test::assert-equal "One1" test-do-one)
994(test::assert-equal "Two" test-do-two)
995(test::assert-equal "Three" test-do-three)
996((fn (idx) (let (v2 (+ idx 2) v3 (+ idx 3))
997 (test::assert-equal (+ idx 2) v2)
998 (test::assert-equal (+ idx 3) v3)
999 (if (< idx 5) (recur (+ idx 1)))))0)
1000((fn (idx) (let (v2 (+ idx 2) v3 (+ idx 3))
1001 (test::assert-equal (+ idx 2) v2)
1002 (test::assert-equal (+ idx 3) v3)
1003 (if (< idx 5) (this-fn (+ idx 1)))))0)"#),
1004 let_while: add_special(vm, "let-while", r#"Usage: (let-while (initial-bindings) (loop bindings) condition & let-body)
1005
1006Takes list of initial bindings (done once before loop) of form (binding0 sexp0, binding1 sexp1, ...),
1007and a list of loop bindings (done at the start of each iteration including the first) and evaluates
1008let-body with all values of binding bound to the result of the evaluation of
1009both bindings while condition is true.
1010
1011Section: core
1012
1013Example:
1014; both of these examples create a vector and iterate to print all the elements
1015; use traditional lisp structure
1016(def test-res [])
1017(let-while (l [1 2 3]) (done (empty? l), f (first l), l (rest l)) (not done)
1018 (prn f)
1019 (vec-push! test-res f))
1020(let ([x y z] test-res)
1021 (test::assert-equal 1 x)
1022 (test::assert-equal 2 y)
1023 (test::assert-equal 3 z))
1024; same thing using destructuring
1025(def test-res [])
1026(let-while (l [1 2 3]) (done (empty? l), [% f & l] l) (not done)
1027 (prn f)
1028 (vec-push! test-res f))
1029(let ([x y z] test-res)
1030 (test::assert-equal 1 x)
1031 (test::assert-equal 2 y)
1032 (test::assert-equal 3 z))
1033"#),
1034 call_cc: add_special(vm, "call/cc", ""),
1035 defer: add_special(vm, "defer", ""),
1036 on_error: add_special(vm, "on-raised-error", r#"Usage: (on-raised-error (fn (error) ...))
1037
1038Low level (consider this unstable) interface to the raised error machinery.
1039Useful for building higher level error handling (get-error for instance).
1040It takes either Nil or a callable with one parameter. That parameter will be
1041the error that was raised. The entire running "chunk" of code will be
1042displaced for the installed handler. Probably best to use this with a
1043continuation or a function that ends in a continuation call otherwise it
1044may be difficult to reason about...
1045
1046Will return the previously installed handler or Nil if one is not installed.
1047Calling with Nil will return the old handler and clear it (no handler
1048installed).
1049
1050This special form will override breaking into the debugger when an error is
1051raised.
1052
1053Section: core
1054
1055Example:
1056(defmacro get-error-test (& body)
1057`(let (old-error (on-raised-error nil))
1058 (defer (on-raised-error old-error))
1059 (call/cc (fn (k) (on-raised-error (fn (err) (k (cons (car err)(cdr err)))))
1060 (cons :ok (do ~@body))))))
1061
1062(test::assert-equal (cons :ok 6) (get-error-test (let (x 1, y 5) (+ x y))))
1063(test::assert-equal '(:test . "error") (get-error-test (let (x 1, y 5) (err :test "error")(+ x y))))
1064"#),
1065 while_: add_special(vm, "while", ""),
1066 doc_string: add_special(vm, "doc-string", ""),
1067 get: add_special(vm, "get", ""),
1068 err: add_special(vm, "err", r#"Usage: (err :keyword value)
1069
1070Raises an error with keyword and value. By default this will break into the
1071debugger like a runtime error (use get-error to avoid this).
1072
1073Section: core
1074
1075Example:
1076(let (error (get-error (err :test "Test error")))
1077 (test::assert-equal :test (car error))
1078 (test::assert-equal "Test error" (cdr error))
1079 (test::assert-true (err? error)))
1080"#),
1081 mk_err: add_special(vm, "mk-err", r#"Usage: (mk-err :keyword value)
1082
1083Create an error object. This does not raise the error but merely creates it.
1084Can use car/cdr to extract the keyword and value.
1085
1086Section: core
1087
1088Example:
1089(let (error (mk-err :test "Test error"))
1090 (test::assert-equal :test (car error))
1091 (test::assert-equal "Test error" (cdr error))
1092 (test::assert-true (err? error)))
1093"#),
1094 is_err: add_special(vm, "err?", r#"Usage: (err? expression)
1095
1096True if the expression is an error, false otherwise.
1097
1098Section: type
1099
1100Example:
1101(test::assert-true (err? (mk-err :arr "test")))
1102(test::assert-false (err? nil))
1103"#),
1104 is_ok: add_special(vm, "ok?", r#"Usage: (ok? expression)
1105
1106True if the expression is NOT an error, false if it is an error.
1107
1108Section: type
1109
1110Example:
1111(test::assert-false (ok? (mk-err :arr "test")))
1112(test::assert-true (ok? nil))
1113"#),
1114 ret: add_special(vm, "return", ""),
1115 ns: add_special(vm, "ns", r#"Usage: (ns SYMBOL)
1116
1117Changes to namespace. This is "open-ended" change and is intended for use with
1118the REPL prefer with-ns for scripts.
1119The symbol "::" will return to the "root" namespace (i.e. no namespace prepended to globals).
1120This will cause all globals defined to have namespace:: prepended.
1121This will also clear any existing imports.
1122
1123Section: namespace
1124
1125Example:
1126(ns testing)
1127(def x #t)
1128(test::assert-true x)
1129(ns ::)
1130(test::assert-true testing::x)
1131"#),
1132 with_ns: add_special(vm, "with-ns", r#"Usage: (with-ns SYMBOL sexp+)
1133
1134Create a namespace and compile sexp+ within it. Restore the previous namespace when scope ends.
1135THe symbol "::" will return to the "root" namespace (i.e. no namespace prepended to globals).
1136This will cause all globals defined to have namespace:: prepended.
1137This will also clear any existing imports.
1138
1139Section: namespace
1140
1141Example:
1142(with-ns test-with-ns
1143 (def ttf (fn () '(1 2 3)))
1144 (test::assert-equal '(1 2 3) (ttf))
1145 (test::assert-equal '(1 2 3) (test-out::ttf)))
1146(test::assert-equal '(1 2 3) (test-out::ttf))
1147"#),
1148 import: add_special(vm, "import", r#"Usage: (import namespace [:as symbol])
1149
1150Will import a namespace. Without an :as then all symbols in the namespace will become available in the current
1151namespace as if local. With [:as symbol] then all namespace symbols become available with symbol:: prepended.
1152
1153Section: namespace
1154
1155Example:
1156(ns testing)
1157(def x #t)
1158(test::assert-true x)
1159(ns ::)
1160(test::assert-true testing::x)
1161(import testing)
1162(test::assert-true x)
1163(import testing :as t)
1164(test::assert-true t::x)
1165"#),
1166 load: add_special(vm, "load", r#"Usage: (load path) -> [last form value]
1167
1168Read and eval a file (from path- a string). The load special form executes at compile time.
1169This means it's parameter must resolve at compile time. Most of the time you will want to use
1170this in conjunction with 'with-ns' to namespace the contents.
1171Note: on it's own does nothing with namespaces.
1172
1173Section: core
1174
1175Example:
1176(comp-time (def test-temp-file (get-temp-file)) nil)
1177(defer (fs-rm test-temp-file))
1178(let (tst-file (fopen test-temp-file :create))
1179 (defer (fclose tst-file))
1180 (fprn tst-file "(with-ns test-load")
1181 (fprn tst-file " (defn test-fn () '(1 2 3)))"))
1182(load test-temp-file) ; put stuff in it's own namespace
1183(test::assert-equal '(1 2 3) (test-load::test-fn))
1184
1185
1186(with-ns test-out2
1187 (comp-time
1188 (def test-temp-file (get-temp-file))
1189 (let (tst-file (fopen test-temp-file :create))
1190 (defer (fclose tst-file))
1191 (fprn tst-file "(defn test-fn () '(1 2 3))"))
1192 nil)
1193 (defer (fs-rm test-temp-file))
1194 (load test-temp-file) ; put new stuff in current namespace
1195 (test::assert-equal '(1 2 3) (test-fn))
1196 (test::assert-equal '(1 2 3) (test-out2::test-fn)))
1197"#),
1198 comp_time: add_special(vm, "comp-time", r#"Usage: (comp-time sexp+)
1199
1200Compile and execute sexp+ at compile time. The result of the final sexp will then be compiled into
1201the current module being compiled (produce nil to avoid this).
1202
1203Section: core
1204
1205Example:
1206(with-ns test-out
1207 (comp-time '(def ttf (fn () '(1 2 3))))
1208 (comp-time (def ttf2 (fn () '(1 2 3))) nil)
1209 (test::assert-equal '(1 2 3) (ttf))
1210 (test::assert-equal '(1 2 3) (test-out::ttf))
1211 (test::assert-equal '(1 2 3) (ttf2))
1212 (test::assert-equal '(1 2 3) (test-out::ttf2)))
1213"#),
1214
1215 rest: vm.intern_static("&"),
1216 optional: vm.intern_static("%"),
1217 scratch: vm.intern_static("[SCRATCH]"),
1218 colon: vm.intern_static(":"),
1219 root: vm.intern_static("ROOT"),
1220 }
1221 }
1222}
1223
1224fn add_special(env: &mut SloshVm, name: &'static str, doc_string: &str) -> Interned {
1225 let i = env.intern_static(name);
1226 let val = Value::Special(i);
1227 let si = env.set_named_global(name, val);
1228 let key = env.intern("doc-string");
1229 let s = env.alloc_string(doc_string.to_string());
1230 env.set_global_property(si, key, s);
1231 i
1232}
1233
1234pub struct CompileState {
1235 pub symbols: Rc<RefCell<Symbols>>,
1236 pub constants: HashMap<Value, usize>,
1237 pub lets: Option<HashMap<Interned, usize>>,
1238 pub chunk: Chunk,
1239 pub max_regs: usize,
1240 pub tail: bool,
1241 pub defers: usize,
1242 pub doc_string: Option<Value>,
1243}
1244
1245impl Default for CompileState {
1246 fn default() -> Self {
1247 Self::new()
1248 }
1249}
1250
1251impl CompileState {
1252 pub fn new() -> Self {
1253 CompileState {
1254 symbols: Rc::new(RefCell::new(Symbols::with_outer(None))),
1255 constants: HashMap::new(),
1256 lets: None,
1257 chunk: Chunk::new("no_file", 1),
1258 max_regs: 0,
1259 tail: false,
1260 defers: 0,
1261 doc_string: None,
1262 }
1263 }
1264
1265 pub fn new_state(
1266 file_name: &'static str,
1267 first_line: u32,
1268 outer: Option<Rc<RefCell<Symbols>>>,
1269 ) -> Self {
1270 let symbols = Rc::new(RefCell::new(Symbols::with_outer(outer)));
1271 CompileState {
1272 symbols,
1273 constants: HashMap::new(),
1274 lets: None,
1275 chunk: Chunk::new(file_name, first_line),
1276 max_regs: 0,
1277 tail: false,
1278 defers: 0,
1279 doc_string: None,
1280 }
1281 }
1282
1283 pub fn reserved_regs(&self) -> usize {
1284 self.symbols.borrow().regs_count()
1285 }
1286
1287 pub fn get_symbol(&self, sym: Interned) -> Option<usize> {
1288 self.symbols.borrow().data.borrow().syms.get(&sym).copied()
1289 }
1290
1291 pub fn add_constant(&mut self, exp: Value) -> usize {
1292 if let Some(i) = self.constants.get(&exp) {
1293 *i
1294 } else {
1295 let const_i = self.chunk.add_constant(exp);
1296 self.constants.insert(exp, const_i);
1297 const_i
1298 }
1299 }
1300}
1301
1302#[derive(Clone, Debug)]
1304pub struct Namespace {
1305 name: String,
1306 imports: Vec<(String, Option<String>)>,
1307}
1308
1309impl Namespace {
1310 pub fn new_with_name(name: String) -> Self {
1311 Self {
1312 name,
1313 imports: vec![],
1314 }
1315 }
1316
1317 pub fn name(&self) -> &str {
1318 &self.name
1319 }
1320}
1321
1322impl Default for Namespace {
1323 fn default() -> Self {
1324 Self {
1325 name: "".to_string(),
1326 imports: vec![],
1327 }
1328 }
1329}
1330
1331pub struct CompileEnvironment {
1332 use_line: bool,
1333 line: u32,
1334 specials: Option<Specials>,
1335 global_map: HashMap<Interned, usize>,
1336 gensym_idx: usize,
1337 namespace: Namespace,
1338 noop_map: HashMap<String, Value>,
1343}
1344
1345impl Default for CompileEnvironment {
1346 fn default() -> Self {
1347 Self::new()
1348 }
1349}
1350
1351impl CompileEnvironment {
1352 pub fn new() -> Self {
1353 Self {
1354 use_line: true,
1355 line: 1,
1356 specials: None,
1357 global_map: HashMap::new(),
1358 noop_map: HashMap::new(),
1359 gensym_idx: 0,
1360 namespace: Namespace {
1361 name: "".to_string(),
1362 imports: vec![],
1363 },
1364 }
1365 }
1366
1367 pub fn next_gensym(&mut self) -> usize {
1368 let r = self.gensym_idx;
1369 self.gensym_idx += 1;
1370 r
1371 }
1372
1373 pub fn line(&self) -> u32 {
1374 self.line
1375 }
1376
1377 pub fn set_namespace(&mut self, namespace: Namespace) {
1378 self.namespace = namespace;
1379 }
1380
1381 pub fn add_ns_import(&mut self, ns: String, alias: Option<String>) {
1382 for (ns_name, ns_alias) in self.namespace.imports.iter_mut() {
1383 if ns_name == &ns {
1384 *ns_alias = alias;
1385 return;
1386 }
1387 }
1388 self.namespace.imports.push((ns, alias));
1389 }
1390
1391 pub fn get_namespace(&self) -> &Namespace {
1392 &self.namespace
1393 }
1394
1395 pub fn save_noop(&mut self, s: String, v: Value) -> Option<Value> {
1398 self.noop_map.insert(s, v)
1399 }
1400
1401 pub fn remove_noop(&mut self, t: impl AsRef<str>) -> Option<Value> {
1404 self.noop_map.remove(t.as_ref())
1405 }
1406}
1407
1408pub type SloshVm = GVm<CompileEnvironment>;
1409
1410pub trait SloshVmTrait {
1411 fn set_line_val(&mut self, state: &mut CompileState, val: Value);
1412 fn get_reserve_global(&mut self, symbol: Interned) -> u32;
1413 fn set_named_global(&mut self, string: &str, value: Value) -> u32;
1414 fn set_global_builtin(&mut self, string: &str, func: CallFuncSig<CompileEnvironment>) -> u32;
1415 fn dump_globals(&self);
1416 fn globals(&self) -> &HashMap<Interned, usize>;
1417 fn own_line(&self) -> Option<u32>;
1418 fn set_line_num(&mut self, line_num: u32);
1419 fn line_num(&self) -> u32;
1420 fn specials(&self) -> &Specials;
1421 fn global_intern_slot(&self, symbol: Interned) -> Option<u32>;
1422}
1423
1424pub fn new_slosh_vm() -> SloshVm {
1425 let temp_env = CompileEnvironment::new();
1426 let mut vm = GVm::new_with_env(temp_env);
1427 let specials = Specials::new(&mut vm);
1428 vm.env_mut().specials = Some(specials);
1429 vm
1430}
1431
1432impl SloshVmTrait for SloshVm {
1433 fn set_line_val(&mut self, state: &mut CompileState, val: Value) {
1434 if let (Some(Value::Int(dline)), Some(Value::StringConst(file_intern))) = (
1435 self.get_heap_property(val, "dbg-line"),
1436 self.get_heap_property(val, "dbg-file"),
1437 ) {
1438 let dline = from_i56(&dline) as u32;
1439 let file_name = self.get_interned(file_intern);
1440 if file_name == state.chunk.file_name && dline > self.env().line {
1441 self.env_mut().line = dline;
1442 }
1443 }
1444 }
1445
1446 fn get_reserve_global(&mut self, symbol: Interned) -> u32 {
1447 if let Some(idx) = self.env().global_map.get(&symbol) {
1448 *idx as u32
1449 } else {
1450 let idx = self.reserve_global();
1451 self.env_mut().global_map.insert(symbol, idx as usize);
1452 idx
1453 }
1454 }
1455
1456 fn set_named_global(&mut self, string: &str, value: Value) -> u32 {
1457 let sym = self.intern(string);
1458 let slot = self.get_reserve_global(sym);
1459 self.set_global(slot, value);
1460 slot
1461 }
1462
1463 fn set_global_builtin(&mut self, string: &str, func: CallFuncSig<CompileEnvironment>) -> u32 {
1464 let f_val = self.add_builtin(func);
1465 self.set_named_global(string, f_val)
1466 }
1467
1468 fn dump_globals(&self) {
1469 println!("GLOBALS:");
1470 let mut ordered_keys = Vec::with_capacity(self.env().global_map.len());
1471 ordered_keys.resize(self.env().global_map.len(), "");
1472 for (k, v) in self.env().global_map.iter() {
1473 ordered_keys[*v] = self.get_interned(*k);
1474 }
1475 for (i, k) in ordered_keys.iter().enumerate() {
1476 println!(
1477 "({:#010x})/{}: {}",
1478 i,
1479 *k,
1480 self.get_global(i as u32).display_value(self)
1481 );
1482 }
1483 println!();
1484 }
1485
1486 fn globals(&self) -> &HashMap<Interned, usize> {
1487 &self.env().global_map
1488 }
1489
1490 fn own_line(&self) -> Option<u32> {
1491 if self.env().use_line {
1492 Some(self.env().line)
1493 } else {
1494 None
1495 }
1496 }
1497
1498 fn set_line_num(&mut self, line_num: u32) {
1499 if self.env().use_line {
1500 self.env_mut().line = line_num;
1501 }
1502 }
1503
1504 fn line_num(&self) -> u32 {
1505 if self.env().use_line {
1506 self.env().line
1507 } else {
1508 0
1509 }
1510 }
1511
1512 fn specials(&self) -> &Specials {
1513 self.env().specials.as_ref().expect("specials are missing!")
1514 }
1515
1516 fn global_intern_slot(&self, symbol: Interned) -> Option<u32> {
1517 fn check_global(vm: &SloshVm, ns: &str, sym: &str) -> Option<u32> {
1518 let mut ns = ns.to_string();
1519 ns.push_str("::");
1520 ns.push_str(sym);
1521 if let Some(i) = vm.get_if_interned(&ns) {
1522 if let Some(global) = vm.env().global_map.get(&i).copied().map(|i| i as u32) {
1523 return Some(global);
1524 }
1525 }
1526 None
1527 }
1528 fn is_alias(alias: &str, sym: &str) -> bool {
1529 let mut a_i = alias.chars();
1530 let mut s_i = sym.chars().peekable();
1531 let mut is_alias = true;
1532 while let (Some(ach), Some(sch)) = (a_i.next(), s_i.peek()) {
1533 if ach != *sch {
1534 is_alias = false;
1535 break;
1536 }
1537 s_i.next();
1538 }
1539 if is_alias {
1540 if let (Some(':'), Some(':')) = (s_i.next(), s_i.next()) {
1541 return true;
1542 }
1543 }
1544 false
1545 }
1546
1547 let sym = self.get_interned(symbol);
1548 if let Some(g) = check_global(self, &self.env().namespace.name, sym) {
1549 return Some(g);
1550 }
1551 for (import, alias) in &self.env().namespace.imports {
1552 if let Some(alias) = alias {
1553 if is_alias(alias, sym) {
1554 let s = sym.replacen(alias, import, 1);
1555 if let Some(i) = self.get_if_interned(&s) {
1556 if let Some(global) =
1557 self.env().global_map.get(&i).copied().map(|i| i as u32)
1558 {
1559 return Some(global);
1560 }
1561 }
1562 }
1563 } else if let Some(g) = check_global(self, import, sym) {
1564 return Some(g);
1565 }
1566 }
1567 self.env()
1568 .global_map
1569 .get(&symbol)
1570 .copied()
1571 .map(|i| i as u32)
1572 }
1573}