plg_runtime/builtins/
typecheck.rs

1//! Type-checking builtins: `var/1`, `nonvar/1`, `atom/1`, `number/1`,
2//! `integer/1`, `float/1`, `compound/1`, `is_list/1`.
3//!
4//! Each deref-tests a single tag. Notable decisions:
5//! - `integer/1` accepts both the immediate `TAG_INT` and the boxed
6//!   `TAG_BIG` (the full i64 range).
7//! - `compound/1` is TRUE for lists: a `TAG_LST` counts as compound
8//!   (`compound([1])` succeeds).
9//! - `is_list/1` walks the tail iteratively and is true only for a
10//!   proper, nil-terminated list (`is_list([a|b])` fails).
11
12use crate::cell::*;
13use crate::machine::Machine;
14use plg_shared::atom::ATOM_NIL;
15
16#[inline]
17fn mref<'a>(m: *mut Machine) -> &'a mut Machine {
18    unsafe { &mut *m }
19}
20
21/// `var/1`: succeeds iff the dereferenced argument is an unbound variable.
22#[unsafe(no_mangle)]
23pub extern "C" fn plg_rt_b_var_1(m: *mut Machine, a: u64) -> i32 {
24    let m = mref(m);
25    (tag_of(m.deref(a)) == TAG_REF) as i32
26}
27
28/// `nonvar/1`: the negation of `var/1`.
29#[unsafe(no_mangle)]
30pub extern "C" fn plg_rt_b_nonvar_1(m: *mut Machine, a: u64) -> i32 {
31    let m = mref(m);
32    (tag_of(m.deref(a)) != TAG_REF) as i32
33}
34
35/// `atom/1`: succeeds iff the argument is an atom.
36#[unsafe(no_mangle)]
37pub extern "C" fn plg_rt_b_atom_1(m: *mut Machine, a: u64) -> i32 {
38    let m = mref(m);
39    (tag_of(m.deref(a)) == TAG_ATOM) as i32
40}
41
42/// `number/1`: any numeric tag (immediate int, boxed big, or float).
43#[unsafe(no_mangle)]
44pub extern "C" fn plg_rt_b_number_1(m: *mut Machine, a: u64) -> i32 {
45    let m = mref(m);
46    matches!(tag_of(m.deref(a)), TAG_INT | TAG_BIG | TAG_FLT) as i32
47}
48
49/// `integer/1`: immediate `TAG_INT` or boxed `TAG_BIG`.
50#[unsafe(no_mangle)]
51pub extern "C" fn plg_rt_b_integer_1(m: *mut Machine, a: u64) -> i32 {
52    let m = mref(m);
53    matches!(tag_of(m.deref(a)), TAG_INT | TAG_BIG) as i32
54}
55
56/// `float/1`: a boxed float.
57#[unsafe(no_mangle)]
58pub extern "C" fn plg_rt_b_float_1(m: *mut Machine, a: u64) -> i32 {
59    let m = mref(m);
60    (tag_of(m.deref(a)) == TAG_FLT) as i32
61}
62
63/// `compound/1`: a structure OR a list cell (lists count as compound).
64#[unsafe(no_mangle)]
65pub extern "C" fn plg_rt_b_compound_1(m: *mut Machine, a: u64) -> i32 {
66    let m = mref(m);
67    matches!(tag_of(m.deref(a)), TAG_STR | TAG_LST) as i32
68}
69
70/// `is_list/1`: a proper (nil-terminated) list. Iterative tail walk so a
71/// long list can't blow the C stack; a partial or improper list fails.
72#[unsafe(no_mangle)]
73pub extern "C" fn plg_rt_b_is_list_1(m: *mut Machine, a: u64) -> i32 {
74    let m = mref(m);
75    let mut cur = m.deref(a);
76    loop {
77        match tag_of(cur) {
78            TAG_ATOM if atom_id(cur) == ATOM_NIL => return 1,
79            TAG_LST => {
80                let idx = payload(cur) as usize;
81                cur = m.deref(m.heap[idx + 1]); // follow the tail
82            }
83            _ => return 0, // var tail, improper tail, or non-list
84        }
85    }
86}
87
88#[cfg(test)]
89mod tests {
90    use super::*;
91    use plg_shared::StringInterner;
92
93    fn machine() -> Box<Machine> {
94        Machine::new(StringInterner::new(), Vec::new())
95    }
96
97    fn big(m: &mut Machine, n: i64) -> Word {
98        let idx = m.heap.len();
99        m.heap.push(n as u64);
100        make(TAG_BIG, idx as u64)
101    }
102
103    fn flt(m: &mut Machine, f: f64) -> Word {
104        let idx = m.heap.len();
105        m.heap.push(f.to_bits());
106        make(TAG_FLT, idx as u64)
107    }
108
109    fn str_term(m: &mut Machine, name: &str, args: &[Word]) -> Word {
110        let f = m.atoms.intern(name);
111        let idx = m.heap.len();
112        m.heap.push(pack_functor(f, args.len() as u32));
113        m.heap.extend_from_slice(args);
114        make(TAG_STR, idx as u64)
115    }
116
117    fn list(m: &mut Machine, head: Word, tail: Word) -> Word {
118        let idx = m.heap.len();
119        m.heap.push(head);
120        m.heap.push(tail);
121        make(TAG_LST, idx as u64)
122    }
123
124    #[test]
125    fn var_nonvar() {
126        let mut m = machine();
127        let v = m.new_var();
128        let mp = &mut *m as *mut Machine;
129        assert_eq!(plg_rt_b_var_1(mp, v), 1);
130        assert_eq!(plg_rt_b_nonvar_1(mp, v), 0);
131        assert_eq!(plg_rt_b_var_1(mp, make_int(3)), 0);
132        assert_eq!(plg_rt_b_nonvar_1(mp, make_int(3)), 1);
133        // bound var derefs to its value (nonvar)
134        m.bind(payload(v) as usize, make_atom(7));
135        let mp = &mut *m as *mut Machine;
136        assert_eq!(plg_rt_b_var_1(mp, v), 0);
137        assert_eq!(plg_rt_b_nonvar_1(mp, v), 1);
138    }
139
140    #[test]
141    fn atom_number_integer_float() {
142        let mut m = machine();
143        let a = make_atom(m.atoms.intern("a"));
144        let b = big(&mut m, 1 << 62);
145        let f = flt(&mut m, 1.5);
146        let mp = &mut *m as *mut Machine;
147        assert_eq!(plg_rt_b_atom_1(mp, a), 1);
148        assert_eq!(plg_rt_b_atom_1(mp, make_int(1)), 0);
149
150        assert_eq!(plg_rt_b_number_1(mp, make_int(1)), 1);
151        assert_eq!(plg_rt_b_number_1(mp, b), 1);
152        assert_eq!(plg_rt_b_number_1(mp, f), 1);
153        assert_eq!(plg_rt_b_number_1(mp, a), 0);
154
155        assert_eq!(plg_rt_b_integer_1(mp, make_int(1)), 1);
156        assert_eq!(plg_rt_b_integer_1(mp, b), 1); // TAG_BIG counts
157        assert_eq!(plg_rt_b_integer_1(mp, f), 0);
158
159        assert_eq!(plg_rt_b_float_1(mp, f), 1);
160        assert_eq!(plg_rt_b_float_1(mp, make_int(1)), 0);
161        assert_eq!(plg_rt_b_float_1(mp, b), 0);
162    }
163
164    #[test]
165    fn compound_includes_lists() {
166        let mut m = machine();
167        let nil = make_atom(ATOM_NIL);
168        let s = str_term(&mut m, "foo", &[make_int(1)]);
169        let l = list(&mut m, make_int(1), nil);
170        let a = make_atom(m.atoms.intern("a"));
171        let mp = &mut *m as *mut Machine;
172        assert_eq!(plg_rt_b_compound_1(mp, s), 1); // foo(1)
173        assert_eq!(plg_rt_b_compound_1(mp, l), 1); // [1] — list IS compound
174        assert_eq!(plg_rt_b_compound_1(mp, a), 0);
175        assert_eq!(plg_rt_b_compound_1(mp, make_int(1)), 0);
176    }
177
178    #[test]
179    fn is_list_proper_partial_improper() {
180        let mut m = machine();
181        let nil = make_atom(ATOM_NIL);
182        // [a, b]
183        let proper = {
184            let inner = list(&mut m, make_atom(2), nil);
185            list(&mut m, make_atom(1), inner)
186        };
187        // [a|b] improper
188        let improper = list(&mut m, make_atom(1), make_atom(2));
189        // [a|V] partial
190        let v = m.new_var();
191        let partial = list(&mut m, make_atom(1), v);
192        let mp = &mut *m as *mut Machine;
193        assert_eq!(plg_rt_b_is_list_1(mp, proper), 1);
194        assert_eq!(plg_rt_b_is_list_1(mp, nil), 1); // [] is a proper list
195        assert_eq!(plg_rt_b_is_list_1(mp, improper), 0);
196        assert_eq!(plg_rt_b_is_list_1(mp, partial), 0);
197        assert_eq!(plg_rt_b_is_list_1(mp, make_int(1)), 0);
198    }
199}
plg_runtime/builtins/typecheck.rs

plg_runtime/builtins/
typecheck.rs
