oftlisp_anf/
primitives.rs

1use std::io::{stdout, Write};
2use std::sync::atomic::{AtomicIsize, Ordering};
3
4use gc::Gc;
5use oftlisp::Value;
6use oftlisp::gensym::gensym as make_gensym;
7use oftlisp::interpreter::Primitives;
8use oftlisp::reader::symbolish::str_is_symbol;
9use oftlisp::util::{from_assoc, to_assoc};
10
11use errors::RuntimeError;
12use types::Context;
13
14/// The primitives for the [`Context`](struct.Context.html).
15pub static PRIMITIVES: Primitives<Context> = Primitives {
16    apply,
17    atomic_word_cas,
18    atomic_word_load,
19    atomic_word_new,
20    atomic_word_store,
21    byte_of_fixnum,
22    bytes_of_string,
23    car,
24    cdr,
25    compare,
26    concat_strings,
27    cons,
28    debug,
29    eq,
30    exit_with,
31    fixnum_of_byte,
32    gensym,
33    is_byte,
34    is_cons,
35    is_fixnum,
36    is_nil,
37    is_object,
38    is_string,
39    is_symbol,
40    is_vector,
41    list_of_vector,
42    make_vector,
43    object_data_len,
44    object_get_data,
45    object_get_func,
46    object_has_func,
47    object_seal,
48    object_unseal,
49    op_add,
50    op_cmp,
51    op_div,
52    op_equ,
53    op_mod,
54    op_mul,
55    op_sub,
56    panic,
57    show_primitive,
58    string_of_symbol,
59    symbol_of_string,
60    unwind_protect,
61    vector_of_list,
62    write_bytes,
63};
64
65type Args = Vec<Gc<Value<Context>>>;
66type Return = Result<Gc<Value<Context>>, RuntimeError>;
67
68macro_rules! args {
69    ([$args:expr, $name:expr]($($req:ident)*) => $block:block) => {
70        args!([$args, $name]($($req)* ... rest) => {
71            if rest.len() == 0 {
72                $block
73            } else {
74                unimplemented!("bad argn in call to {}", $name)
75            }
76        })
77    };
78    ([$args:expr, $name:expr]($($req:ident)* ... $rest:ident) => $block:block) => {{
79        let mut args = $args;
80        args.reverse();
81        $(let $req = if args.is_empty() {
82            unimplemented!("bad argn in call to {}", $name)
83        } else {
84            args.pop().unwrap()
85        };)*
86        args.reverse();
87        let $rest = args;
88        #[allow(unused_macros)]
89        macro_rules! __oftlisp_func_name {
90            () => { $name };
91        }
92        $block
93    }};
94}
95macro_rules! type_check {
96    (atomic <- $expr:expr) => { type_check!(Value::AtomicWord(ref n, _), n, $expr) };
97    (byte <- $expr:expr) => { type_check!(Value::Byte(n, _), n, $expr) };
98    (bytes <- $expr:expr) => { type_check!(Value::Bytes(ref b, _), b, $expr) };
99    (cons <- $expr:expr) => { type_check!(Value::Cons(ref h, ref t, _), (h, t), $expr) };
100    (fixnum <- $expr:expr) => { type_check!(Value::Fixnum(n, _), n, $expr) };
101    (obj <- $expr:expr) => { type_check!(Value::Object(ref f, ref d, _), (f, d), $expr) };
102    (string <- $expr:expr) => { type_check!(Value::String(ref s, _), s, $expr) };
103    (symbol <- $expr:expr) => { type_check!(Value::Symbol(s, _), s, $expr) };
104    (vector <- $expr:expr) => { type_check!(Value::Vector(ref v, _), v, $expr) };
105    ($pat:pat, $out:expr, $expr:expr) => {{
106        let value = &*$expr;
107        if let $pat = *value {
108            $out
109        } else {
110            unimplemented!("type_check in {} failed: could not match {} with {}", __oftlisp_func_name!(), value, stringify!($pat))
111        }
112    }};
113
114    (list <- $expr:expr) => {{
115        let value = $expr;
116        if let Some(l) = $crate::oftlisp::util::as_list(value.clone()) {
117            l
118        } else {
119            unimplemented!("type_check in {} failed: {} is not a list", __oftlisp_func_name!(), value)
120        }
121    }};
122}
123macro_rules! define_ops {
124    ($(($sym_name:ident, $fn_name:expr) = $fn:expr;)*) => {
125        $(fn $sym_name(args: Args) -> Return {
126            args!([args, $fn_name](l r) => {
127                match (&*l, &*r) {
128                    (&Value::Byte(a, _), &Value::Byte(b, _)) => {
129                        Ok(Gc::new(Value::Byte(($fn)(a, b), Default::default())))
130                    },
131                    (&Value::Fixnum(a, _), &Value::Fixnum(b, _)) => {
132                        Ok(Gc::new(Value::Fixnum(($fn)(a, b), Default::default())))
133                    },
134                    (_, _) => unimplemented!("invalid arg types to {}", __oftlisp_func_name!()),
135                }
136            })
137        })*
138    };
139}
140
141define_ops! {
142    (op_add, "+/2") = |a, b| a + b;
143    (op_sub, "-/2") = |a, b| a - b;
144    (op_mul, "*/2") = |a, b| a * b;
145    (op_div, "//2") = |a, b| a / b;
146    (op_mod, "mod/2") = |a, b| a % b;
147}
148
149fn apply(args: Args) -> Return {
150    args!([args, "apply"](func args) => {
151        let args = type_check!(list <- args);
152        match *func {
153            Value::BuiltinFunction(..) | Value::Func(..) => {
154                Context::apply(func, args)
155            },
156            _ => unimplemented!("cannot apply to non-func"),
157        }
158    })
159}
160
161fn atomic_word_cas(args: Args) -> Return {
162    args!([args, "atomic-word.cas"](a before after) => {
163        let a = type_check!(atomic <- a);
164        let before = type_check!(fixnum <- before);
165        let after = type_check!(fixnum <- after);
166        let n = a.compare_and_swap(before, after, Ordering::SeqCst);
167        Ok(Gc::new(Value::Fixnum(n, Default::default())))
168    })
169}
170
171fn atomic_word_load(args: Args) -> Return {
172    args!([args, "atomic-word.load"](a) => {
173        let a = type_check!(atomic <- a);
174        let n = a.load(Ordering::SeqCst);
175        Ok(Gc::new(Value::Fixnum(n, Default::default())))
176    })
177}
178
179fn atomic_word_new(args: Args) -> Return {
180    args!([args, "atomic-word.new"](n) => {
181        let n = type_check!(fixnum <- n);
182        Ok(Gc::new(Value::AtomicWord(AtomicIsize::new(n), Default::default())))
183    })
184}
185
186fn atomic_word_store(args: Args) -> Return {
187    args!([args, "atomic-word.store"](a n) => {
188        let a = type_check!(atomic <- a);
189        let n = type_check!(fixnum <- n);
190        a.store(n, Ordering::SeqCst);
191        Ok(Gc::new(Value::Nil(Default::default())))
192    })
193}
194
195fn byte_of_fixnum(args: Args) -> Return {
196    args!([args, "byte<-fixnum"](val) => {
197        let n = type_check!(fixnum <- val);
198        Ok(Gc::new(if n >= 0 && n < 256 {
199            Value::Byte(n as u8, Default::default())
200        } else {
201            Value::Nil(Default::default())
202        }))
203    })
204}
205
206fn bytes_of_string(args: Args) -> Return {
207    args!([args, "bytes<-string"](val) => {
208        let s = type_check!(string <- val);
209        let bs = Gc::new(Clone::clone(&**s).into_bytes());
210        Ok(Gc::new(Value::Bytes(bs, Default::default())))
211    })
212}
213
214fn car(args: Args) -> Return {
215    args!([args, "car"](l) => {
216        let (h, _) = type_check!(cons <- l);
217        Ok(h.clone())
218    })
219}
220
221fn compare(args: Args) -> Return {
222    args!([args, "compare"](x y) => {
223        Ok(Value::ordering(x.partial_cmp(&y)))
224    })
225}
226
227fn cdr(args: Args) -> Return {
228    args!([args, "cdr"](l) => {
229        let (_, t) = type_check!(cons <- l);
230        Ok(t.clone())
231    })
232}
233
234fn concat_strings(args: Args) -> Return {
235    args!([args, "concat-strings"](... strs) => {
236        let mut buf = String::new();
237        for s in strs {
238            let s = type_check!(string <- s);
239            buf += s;
240        }
241        Ok(Gc::new(Value::String(Gc::new(buf), Default::default())))
242    })
243}
244
245fn cons(args: Args) -> Return {
246    args!([args, "cons"](h t) => {
247        Ok(Gc::new(Value::Cons(h, t, Default::default())))
248    })
249}
250
251fn debug(args: Args) -> Return {
252    args!([args, "debug"](x) => {
253        warn!("{}", x);
254        Ok(x)
255    })
256}
257
258fn eq(args: Args) -> Return {
259    args!([args, "eq"](l r) => {
260        Ok(Value::bool(l == r))
261    })
262}
263
264fn exit_with(args: Args) -> Return {
265    args!([args, "exit-with"](code) => {
266        let code = type_check!(byte <- code);
267        Err(RuntimeError::Exit(code))
268    })
269}
270
271fn fixnum_of_byte(args: Args) -> Return {
272    args!([args, "fixnum<-byte"](val) => {
273        let n = type_check!(byte <- val);
274        Ok(Gc::new(Value::Fixnum(n as isize, Default::default())))
275    })
276}
277
278fn gensym(args: Args) -> Return {
279    args!([args, "gensym"]() => {
280        Ok(Gc::new(Value::Symbol(make_gensym(), Default::default())))
281    })
282}
283
284fn is_byte(args: Args) -> Return {
285    args!([args, "byte?"](val) => {
286        Ok(Value::bool(if let Value::Byte(..) = *val {
287            true
288        } else {
289            false
290        }))
291    })
292}
293
294fn is_cons(args: Args) -> Return {
295    args!([args, "cons?"](val) => {
296        Ok(Value::bool(if let Value::Cons(..) = *val {
297            true
298        } else {
299            false
300        }))
301    })
302}
303
304fn is_fixnum(args: Args) -> Return {
305    args!([args, "fixnum?"](val) => {
306        Ok(Value::bool(if let Value::Fixnum(..) = *val {
307            true
308        } else {
309            false
310        }))
311    })
312}
313
314fn is_nil(args: Args) -> Return {
315    args!([args, "nil?"](val) => {
316        Ok(Value::bool(if let Value::Nil(_) = *val {
317            true
318        } else {
319            false
320        }))
321    })
322}
323
324fn is_object(args: Args) -> Return {
325    args!([args, "object?"](val) => {
326        Ok(Value::bool(if let Value::Object(..) = *val {
327            true
328        } else {
329            false
330        }))
331    })
332}
333
334fn is_symbol(args: Args) -> Return {
335    args!([args, "symbol?"](val) => {
336        Ok(Value::bool(if let Value::Symbol(..) = *val {
337            true
338        } else {
339            false
340        }))
341    })
342}
343
344fn is_string(args: Args) -> Return {
345    args!([args, "string?"](val) => {
346        Ok(Value::bool(if let Value::String(..) = *val {
347            true
348        } else {
349            false
350        }))
351    })
352}
353
354fn is_vector(args: Args) -> Return {
355    args!([args, "vector?"](val) => {
356        Ok(Value::bool(if let Value::Vector(..) = *val {
357            true
358        } else {
359            false
360        }))
361    })
362}
363
364fn list_of_vector(args: Args) -> Return {
365    args!([args, "list<-vector"](v) => {
366        let v = type_check!(vector <- v);
367        Ok(Value::list(v.clone(), Default::default()))
368    })
369}
370
371fn make_vector(args: Args) -> Return {
372    args!([args, "make-vector"](l) => {
373        let l = type_check!(fixnum <- l) as usize;
374        let v = vec![Gc::new(Value::Nil(Default::default())); l];
375        Ok(Gc::new(Value::Vector(v, Default::default())))
376    })
377}
378
379fn object_data_len(args: Args) -> Return {
380    args!([args, "object-data-len"](val) => {
381        let (_, data) = type_check!(obj <- val);
382        Ok(Gc::new(Value::Fixnum(data.len() as isize, Default::default())))
383    })
384}
385
386fn object_get_data(args: Args) -> Return {
387    args!([args, "object-get-data"](val i) => {
388        let (_, data) = type_check!(obj <- val);
389        let i = type_check!(fixnum <- i);
390        if i < 0 || i as usize >= data.len() {
391            return Err(RuntimeError::ObjectDataOutOfBounds(i, val.clone()));
392        } else {
393            Ok(data[i as usize].clone())
394        }
395    })
396}
397
398fn object_get_func(args: Args) -> Return {
399    args!([args, "object-get-func"](val name) => {
400        let (vt, _) = type_check!(obj <- val);
401        let name = type_check!(symbol <- name);
402        if let Some(func) = vt.get(&name) {
403            Ok(func.clone())
404        } else {
405            Err(RuntimeError::ObjectNoSuchFunc(name, val.clone()))
406        }
407    })
408}
409
410fn object_has_func(args: Args) -> Return {
411    args!([args, "object-has-func?"](val name) => {
412        let (vt, _) = type_check!(obj <- val);
413        let name = type_check!(symbol <- name);
414        Ok(Value::bool(vt.contains_key(&name)))
415    })
416}
417
418fn object_seal(args: Args) -> Return {
419    args!([args, "object-seal"](vtbl data) => {
420        let vtbl = if let Some(vtbl) = from_assoc(vtbl.clone()) {
421            vtbl
422        } else {
423            return Err(RuntimeError::InvalidVTable(vtbl));
424        };
425        let data = type_check!(vector <- data);
426        Ok(Gc::new(Value::Object(vtbl, data.clone(), Default::default())))
427    })
428}
429
430fn object_unseal(args: Args) -> Return {
431    args!([args, "object-unseal"](val) => {
432        let (vtbl, data) = type_check!(obj <- val);
433        let vtbl = to_assoc(vtbl);
434        let data = Value::vector(data.clone());
435        Ok(Gc::new(Value::Cons(vtbl, data, Default::default())))
436    })
437}
438
439fn op_cmp(args: Args) -> Return {
440    args!([args, "<>"](l r) => {
441        match (&*l, &*r) {
442            (&Value::Fixnum(l, _), &Value::Fixnum(r, _)) => Ok(Value::ordering(Some(l.cmp(&r)))),
443            (_, _) => unimplemented!("invalid arg types to <>"),
444        }
445    })
446}
447
448fn op_equ(args: Args) -> Return {
449    args!([args, "="](l r) => {
450        Ok(Value::bool(l == r))
451    })
452}
453
454fn panic(args: Args) -> Return {
455    Err(RuntimeError::Panic(args))
456}
457
458fn show_primitive(args: Args) -> Return {
459    args!([args, "show-primitive"](val) => {
460        let s = Gc::new(format!("{}", val));
461        Ok(Gc::new(Value::String(s, Default::default())))
462    })
463}
464
465fn string_of_symbol(args: Args) -> Return {
466    args!([args, "string<-symbol"](val) => {
467        let s = type_check!(symbol <- val);
468        Ok(Gc::new(Value::String(Gc::new(s.to_string()), Default::default())))
469    })
470}
471
472fn symbol_of_string(args: Args) -> Return {
473    args!([args, "symbol<-string"](val) => {
474        let s = type_check!(string <- val);
475        Ok(Gc::new(if str_is_symbol(s) {
476            Value::Symbol(s.as_str().into(), Default::default())
477        } else {
478            Value::Nil(Default::default())
479        }))
480    })
481}
482
483fn unwind_protect(args: Args) -> Return {
484    args!([args, "unwind-protect"](try finally) => {
485        let val = Context::apply(try, vec![]);
486        Context::apply(finally, vec![])?;
487        val
488    })
489}
490
491fn vector_of_list(args: Args) -> Return {
492    args!([args, "vector<-list"](l) => {
493        let l = type_check!(list <- l);
494        Ok(Value::vector(l))
495    })
496}
497
498fn write_bytes(args: Args) -> Return {
499    args!([args, "write-bytes"](val) => {
500        let bs = type_check!(bytes <- val);
501        stdout().write_all(bs)?;
502        Ok(Gc::new(Value::Nil(Default::default())))
503    })
504}
oftlisp_anf/primitives.rs

oftlisp_anf/
primitives.rs
