plg_runtime/builtins/
sortops.rs

1//! List-sorting builtins: `msort/2`, `sort/2`.
2//!
3//! Ported byte-for-byte from patch-prolog v1 (`solver.rs` MSort/Sort
4//! arms). Both sort by the standard order of terms (`compare_terms`):
5//! - `msort/2` is a stable sort that KEEPS duplicates.
6//! - `sort/2` sorts and then removes adjacent `Equal` duplicates.
7//!
8//! The first argument must be a proper list; otherwise v1 raises a
9//! `type_error(list, Culprit)` (oracle-verified). The result is built on
10//! the heap.
11
12use crate::builtins::order::compare_terms;
13use crate::cell::*;
14use crate::machine::Machine;
15use crate::unify::unify;
16use plg_shared::atom::ATOM_NIL;
17use std::cmp::Ordering;
18
19#[inline]
20fn mref<'a>(m: *mut Machine) -> &'a mut Machine {
21    unsafe { &mut *m }
22}
23
24/// Collect a proper list's element words; `None` if not nil-terminated.
25fn collect_list(m: &Machine, w: Word) -> Option<Vec<Word>> {
26    let mut out = Vec::new();
27    let mut cur = m.deref(w);
28    loop {
29        match tag_of(cur) {
30            TAG_ATOM if atom_id(cur) == ATOM_NIL => return Some(out),
31            TAG_LST => {
32                let idx = payload(cur) as usize;
33                out.push(m.heap[idx]);
34                cur = m.deref(m.heap[idx + 1]);
35            }
36            _ => return None,
37        }
38    }
39}
40
41/// Build a nil-terminated list from words; return its word.
42fn build_list(m: &mut Machine, elems: &[Word]) -> Word {
43    let mut tail = make_atom(ATOM_NIL);
44    for &e in elems.iter().rev() {
45        let idx = m.heap.len();
46        m.heap.push(e);
47        m.heap.push(tail);
48        tail = make(TAG_LST, idx as u64);
49    }
50    tail
51}
52
53/// `msort/2`: stable sort by standard order, duplicates kept.
54#[unsafe(no_mangle)]
55pub extern "C" fn plg_rt_b_msort_2(m: *mut Machine, list: u64, sorted: u64, site_id: u32) -> i32 {
56    let _site = crate::machine::ErrorSiteGuard::enter(m, site_id);
57    let m = mref(m);
58    let Some(mut elems) = collect_list(m, list) else {
59        let culprit = m.deref(list);
60        crate::errors::type_error(m, "list", culprit, "msort/2: first argument must be a list");
61        return 0;
62    };
63    elems.sort_by(|&a, &b| compare_terms(m, a, b));
64    let lst = build_list(m, &elems);
65    unify(m, sorted, lst) as i32
66}
67
68/// `sort/2`: sort by standard order then drop adjacent `Equal` dups.
69#[unsafe(no_mangle)]
70pub extern "C" fn plg_rt_b_sort_2(m: *mut Machine, list: u64, sorted: u64, site_id: u32) -> i32 {
71    let _site = crate::machine::ErrorSiteGuard::enter(m, site_id);
72    let m = mref(m);
73    let Some(mut elems) = collect_list(m, list) else {
74        let culprit = m.deref(list);
75        crate::errors::type_error(m, "list", culprit, "sort/2: first argument must be a list");
76        return 0;
77    };
78    elems.sort_by(|&a, &b| compare_terms(m, a, b));
79    elems.dedup_by(|&mut a, &mut b| compare_terms(m, a, b) == Ordering::Equal);
80    let lst = build_list(m, &elems);
81    unify(m, sorted, lst) as i32
82}
83
84#[cfg(test)]
85mod tests {
86    use super::*;
87    use crate::machine::NO_SITE;
88    use plg_shared::StringInterner;
89
90    fn machine() -> Box<Machine> {
91        Machine::new(StringInterner::new(), Vec::new())
92    }
93
94    // Thin wrappers: existing tests exercise behavior, not provenance.
95    fn msort(m: *mut Machine, l: u64, s: u64) -> i32 {
96        plg_rt_b_msort_2(m, l, s, NO_SITE)
97    }
98    fn sort(m: *mut Machine, l: u64, s: u64) -> i32 {
99        plg_rt_b_sort_2(m, l, s, NO_SITE)
100    }
101
102    fn msg(m: &Machine) -> &str {
103        m.error.as_ref().unwrap().message.as_str()
104    }
105
106    fn ints(m: &mut Machine, vals: &[i64]) -> Word {
107        let ws: Vec<Word> = vals.iter().map(|&v| make_int(v)).collect();
108        build_list(m, &ws)
109    }
110
111    #[test]
112    fn msort_keeps_duplicates() {
113        let mut m = machine();
114        let l = ints(&mut m, &[3, 1, 2, 1]);
115        let out = m.new_var();
116        let mp = &mut *m as *mut Machine;
117        assert_eq!(msort(mp, l, out), 1);
118        let got: Vec<i64> = collect_list(&m, out)
119            .unwrap()
120            .iter()
121            .map(|&w| int_value(m.deref(w)))
122            .collect();
123        assert_eq!(got, vec![1, 1, 2, 3]);
124    }
125
126    #[test]
127    fn sort_dedups_adjacent_equal() {
128        let mut m = machine();
129        let l = ints(&mut m, &[3, 1, 2, 1]);
130        let out = m.new_var();
131        let mp = &mut *m as *mut Machine;
132        assert_eq!(sort(mp, l, out), 1);
133        let got: Vec<i64> = collect_list(&m, out)
134            .unwrap()
135            .iter()
136            .map(|&w| int_value(m.deref(w)))
137            .collect();
138        assert_eq!(got, vec![1, 2, 3]);
139    }
140
141    #[test]
142    fn sort_non_list_errors() {
143        let mut m = machine();
144        let foo = make_atom(m.atoms.intern("foo"));
145        let out = m.new_var();
146        let mp = &mut *m as *mut Machine;
147        assert_eq!(sort(mp, foo, out), 0);
148        assert_eq!(
149            msg(&m),
150            "error(type_error(list, foo), sort/2: first argument must be a list)"
151        );
152
153        let mut m = machine();
154        let foo = make_atom(m.atoms.intern("foo"));
155        let out = m.new_var();
156        let mp = &mut *m as *mut Machine;
157        assert_eq!(msort(mp, foo, out), 0);
158        assert_eq!(
159            msg(&m),
160            "error(type_error(list, foo), msort/2: first argument must be a list)"
161        );
162    }
163}
plg_runtime/builtins/sortops.rs

plg_runtime/builtins/
sortops.rs
