Skip to main content

sim_lib_lang_prolog/
surface.rs

1use std::{
2    fs,
3    path::Path,
4    sync::{Arc, Mutex},
5};
6
7use sim_codec::{Input, decode_with_codec};
8use sim_kernel::{
9    AbiVersion, Args, Callable, ClassRef, Cx, Error, Expr, Lib, LibManifest, LibTarget, Linker,
10    LoadCx, Object, QuoteMode, RawArgs, ReadPolicy, Result, Symbol, Value, Version,
11    logic_consult_file_capability, logic_db_write_capability,
12};
13use sim_lib_logic::{LogicConfig, LogicDb, LogicPolicy, SearchStrategy, query};
14
15use crate::exports::prolog_export_declarations;
16
17const PROLOG_LIB_ID: &str = "prolog";
18const DB_SYMBOL: &str = "db";
19const CONFIG_SYMBOL: &str = "config-state";
20
21/// The loadable Prolog surface organ.
22///
23/// Loading the organ registers `prolog/*` functions plus the state handles used
24/// by [`install_prolog_lib`] to point the active logic eval policy at the same
25/// clause database.
26pub struct PrologLib;
27
28impl Lib for PrologLib {
29    fn manifest(&self) -> LibManifest {
30        LibManifest {
31            id: Symbol::new(PROLOG_LIB_ID),
32            version: Version(env!("CARGO_PKG_VERSION").to_owned()),
33            abi: AbiVersion { major: 0, minor: 1 },
34            target: LibTarget::HostRegistered,
35            requires: Vec::new(),
36            capabilities: Vec::new(),
37            exports: prolog_export_declarations(),
38        }
39    }
40
41    fn load(&self, cx: &mut LoadCx, linker: &mut Linker<'_>) -> Result<()> {
42        register_prolog_functions(cx, linker)?;
43        linker.value(
44            Symbol::qualified("prolog", DB_SYMBOL),
45            cx.factory().opaque(Arc::new(PrologDbState::default()))?,
46        )?;
47        linker.value(
48            Symbol::qualified("prolog", CONFIG_SYMBOL),
49            cx.factory()
50                .opaque(Arc::new(PrologConfigState::default()))?,
51        )?;
52        Ok(())
53    }
54}
55
56/// Installs the Prolog surface into `cx` and makes its logic policy active.
57///
58/// Repeated calls keep the installed database and reset the active eval policy
59/// to the installed Prolog database, so direct expression evaluation and
60/// `prolog/*` calls see the same asserted clauses.
61pub fn install_prolog_lib(cx: &mut Cx) -> Result<()> {
62    let _ = sim_lib_core::install_once(cx, &PrologLib)?;
63    let db = prolog_db_state(cx)?.handle();
64    let config = prolog_config_state(cx)?.lock()?.clone();
65    cx.set_eval_policy(Arc::new(LogicPolicy::from_shared(db, config)));
66    Ok(())
67}
68
69#[derive(Clone, Default)]
70struct PrologDbState {
71    inner: Arc<Mutex<LogicDb>>,
72}
73
74impl PrologDbState {
75    fn handle(&self) -> Arc<Mutex<LogicDb>> {
76        Arc::clone(&self.inner)
77    }
78
79    fn lock(&self) -> Result<std::sync::MutexGuard<'_, LogicDb>> {
80        self.inner
81            .lock()
82            .map_err(|_| Error::PoisonedLock("prolog db"))
83    }
84}
85
86impl Object for PrologDbState {
87    fn display(&self, _cx: &mut Cx) -> Result<String> {
88        Ok("#<prolog-db>".to_owned())
89    }
90
91    fn as_any(&self) -> &dyn std::any::Any {
92        self
93    }
94}
95
96impl sim_kernel::ObjectCompat for PrologDbState {
97    fn class(&self, cx: &mut Cx) -> Result<ClassRef> {
98        cx.factory().class_stub(
99            sim_kernel::ClassId(0),
100            Symbol::qualified("prolog", "DbState"),
101        )
102    }
103}
104
105#[derive(Clone, Default)]
106struct PrologConfigState {
107    inner: Arc<Mutex<LogicConfig>>,
108}
109
110impl PrologConfigState {
111    fn lock(&self) -> Result<std::sync::MutexGuard<'_, LogicConfig>> {
112        self.inner
113            .lock()
114            .map_err(|_| Error::PoisonedLock("prolog config"))
115    }
116}
117
118impl Object for PrologConfigState {
119    fn display(&self, _cx: &mut Cx) -> Result<String> {
120        Ok("#<prolog-config>".to_owned())
121    }
122
123    fn as_any(&self) -> &dyn std::any::Any {
124        self
125    }
126}
127
128impl sim_kernel::ObjectCompat for PrologConfigState {
129    fn class(&self, cx: &mut Cx) -> Result<ClassRef> {
130        cx.factory().class_stub(
131            sim_kernel::ClassId(0),
132            Symbol::qualified("prolog", "ConfigState"),
133        )
134    }
135}
136
137struct PrologFunction {
138    symbol: Symbol,
139    implementation: fn(&mut Cx, &[Expr]) -> Result<Value>,
140}
141
142impl Object for PrologFunction {
143    fn display(&self, _cx: &mut Cx) -> Result<String> {
144        Ok(format!("#<function {}>", self.symbol))
145    }
146
147    fn as_any(&self) -> &dyn std::any::Any {
148        self
149    }
150}
151
152impl sim_kernel::ObjectCompat for PrologFunction {
153    fn class(&self, cx: &mut Cx) -> Result<ClassRef> {
154        cx.resolve_class(&Symbol::qualified("core", "Function"))
155    }
156
157    fn as_callable(&self) -> Option<&dyn Callable> {
158        Some(self)
159    }
160}
161
162impl Callable for PrologFunction {
163    fn call(&self, _cx: &mut Cx, _args: Args) -> Result<Value> {
164        Err(prolog_eval_error(format!(
165            "{} must be called from source expressions",
166            self.symbol
167        )))
168    }
169
170    fn call_exprs(&self, cx: &mut Cx, args: RawArgs) -> Result<Value> {
171        (self.implementation)(cx, args.exprs())
172    }
173}
174
175fn register_prolog_functions(cx: &mut LoadCx, linker: &mut Linker<'_>) -> Result<()> {
176    for (symbol, implementation) in [
177        (
178            Symbol::qualified("prolog", "assert!"),
179            prolog_assert_fn as fn(&mut Cx, &[Expr]) -> Result<Value>,
180        ),
181        (Symbol::qualified("prolog", "retract!"), prolog_retract_fn),
182        (Symbol::qualified("prolog", "query"), prolog_query_fn),
183        (
184            Symbol::qualified("prolog", "query/all"),
185            prolog_query_all_fn,
186        ),
187        (
188            Symbol::qualified("prolog", "query-seq"),
189            prolog_query_seq_fn,
190        ),
191        (Symbol::qualified("prolog", "consult"), prolog_consult_fn),
192    ] {
193        linker.function_value(
194            symbol.clone(),
195            cx.factory().opaque(Arc::new(PrologFunction {
196                symbol,
197                implementation,
198            }))?,
199        )?;
200    }
201    Ok(())
202}
203
204fn prolog_assert_fn(cx: &mut Cx, args: &[Expr]) -> Result<Value> {
205    cx.require(&logic_db_write_capability())?;
206    let [expr] = args else {
207        return Err(prolog_eval_error(
208            "prolog/assert! expects one quoted clause",
209        ));
210    };
211    prolog_db_state(cx)?
212        .lock()?
213        .assert_clause_expr(unquote(expr))?;
214    cx.factory().bool(true)
215}
216
217fn prolog_retract_fn(cx: &mut Cx, args: &[Expr]) -> Result<Value> {
218    cx.require(&logic_db_write_capability())?;
219    let [expr] = args else {
220        return Err(prolog_eval_error(
221            "prolog/retract! expects one quoted clause",
222        ));
223    };
224    let removed = prolog_db_state(cx)?
225        .lock()?
226        .retract_clause_expr(&unquote(expr))?;
227    cx.factory().bool(removed)
228}
229
230fn prolog_query_fn(cx: &mut Cx, args: &[Expr]) -> Result<Value> {
231    let [goal, rest @ ..] = args else {
232        return Err(prolog_eval_error("prolog/query expects a goal"));
233    };
234    let config = prolog_query_config(cx, rest)?;
235    let db = prolog_db_state(cx)?.lock()?.clone();
236    let stream = query(cx, &db, &config, unquote(goal))?;
237    match stream.collect(cx, Some(1))?.into_iter().next() {
238        Some(answer) => Ok(answer),
239        None => cx.factory().nil(),
240    }
241}
242
243fn prolog_query_all_fn(cx: &mut Cx, args: &[Expr]) -> Result<Value> {
244    let [goal, rest @ ..] = args else {
245        return Err(prolog_eval_error("prolog/query/all expects a goal"));
246    };
247    let config = prolog_query_config(cx, rest)?;
248    let db = prolog_db_state(cx)?.lock()?.clone();
249    let stream = query(cx, &db, &config, unquote(goal))?;
250    let answers = stream.collect(cx, config.limits.max_answers)?;
251    cx.factory().list(answers)
252}
253
254fn prolog_query_seq_fn(cx: &mut Cx, args: &[Expr]) -> Result<Value> {
255    let [goal, rest @ ..] = args else {
256        return Err(prolog_eval_error("prolog/query-seq expects a goal"));
257    };
258    let config = prolog_query_config(cx, rest)?;
259    let db = prolog_db_state(cx)?.lock()?.clone();
260    let stream = query(cx, &db, &config, unquote(goal))?;
261    cx.factory().opaque(Arc::new(stream))
262}
263
264fn prolog_consult_fn(cx: &mut Cx, args: &[Expr]) -> Result<Value> {
265    cx.require(&logic_db_write_capability())?;
266    let [expr] = args else {
267        return Err(prolog_eval_error(
268            "prolog/consult expects one path or quoted program",
269        ));
270    };
271    let program = unquote(expr);
272    let count = match program {
273        Expr::String(path) => {
274            let state = prolog_db_state(cx)?;
275            let mut db = state.lock()?;
276            prolog_consult_path(cx, &mut db, &path)?
277        }
278        Expr::Symbol(path) => {
279            let state = prolog_db_state(cx)?;
280            let mut db = state.lock()?;
281            prolog_consult_path(cx, &mut db, &path.to_string())?
282        }
283        other => {
284            let state = prolog_db_state(cx)?;
285            let mut db = state.lock()?;
286            prolog_consult_expr(&mut db, other)?
287        }
288    };
289    cx.factory().string(count.to_string())
290}
291
292fn prolog_db_state(cx: &mut Cx) -> Result<PrologDbState> {
293    cx.resolve_value(&Symbol::qualified("prolog", DB_SYMBOL))?
294        .object()
295        .downcast_ref::<PrologDbState>()
296        .cloned()
297        .ok_or(Error::TypeMismatch {
298            expected: "prolog db state",
299            found: "non-prolog-db",
300        })
301}
302
303fn prolog_config_state(cx: &mut Cx) -> Result<PrologConfigState> {
304    cx.resolve_value(&Symbol::qualified("prolog", CONFIG_SYMBOL))?
305        .object()
306        .downcast_ref::<PrologConfigState>()
307        .cloned()
308        .ok_or(Error::TypeMismatch {
309            expected: "prolog config state",
310            found: "non-prolog-config",
311        })
312}
313
314fn prolog_query_config(cx: &mut Cx, options: &[Expr]) -> Result<LogicConfig> {
315    let mut config = prolog_config_state(cx)?.lock()?.clone();
316    if !options.len().is_multiple_of(2) {
317        return Err(prolog_eval_error(
318            "prolog query options must be key/value pairs",
319        ));
320    }
321    for pair in options.chunks(2) {
322        let key = keyword(&pair[0])?;
323        match key.as_str() {
324            "limit" | "answer-limit" | "max-answers" => {
325                config.limits.max_answers = Some(usize_from_expr(cx, &pair[1])?)
326            }
327            "buffer" | "stream-buffer" => config.stream_buffer = usize_from_expr(cx, &pair[1])?,
328            "strategy" => {
329                let symbol = symbol_expr(cx, &pair[1])?;
330                config.strategy = SearchStrategy::from_symbol(&symbol)
331                    .ok_or_else(|| prolog_eval_error(format!("unsupported strategy {symbol}")))?;
332            }
333            other => {
334                return Err(prolog_eval_error(format!(
335                    "prolog query does not support :{other}"
336                )));
337            }
338        }
339    }
340    Ok(config)
341}
342
343fn keyword(expr: &Expr) -> Result<String> {
344    let Expr::Symbol(symbol) = expr else {
345        return Err(prolog_eval_error("expected keyword symbol"));
346    };
347    Ok(symbol.name.trim_start_matches(':').to_owned())
348}
349
350fn symbol_expr(cx: &mut Cx, expr: &Expr) -> Result<Symbol> {
351    match unquote(expr) {
352        Expr::Symbol(symbol) => Ok(symbol),
353        other => match cx.eval_expr(other)?.object().as_expr(cx)? {
354            Expr::Symbol(symbol) => Ok(symbol),
355            _ => Err(prolog_eval_error("expected symbol")),
356        },
357    }
358}
359
360fn usize_from_expr(cx: &mut Cx, expr: &Expr) -> Result<usize> {
361    match unquote(expr) {
362        Expr::Number(number) => number
363            .canonical
364            .parse::<usize>()
365            .map_err(|_| prolog_eval_error(format!("expected usize, found {}", number.canonical))),
366        Expr::String(text) => text
367            .parse::<usize>()
368            .map_err(|_| prolog_eval_error(format!("expected usize, found {text}"))),
369        Expr::Symbol(symbol) => symbol
370            .name
371            .parse::<usize>()
372            .map_err(|_| prolog_eval_error(format!("expected usize, found {symbol}"))),
373        other => match cx.eval_expr(other)?.object().as_expr(cx)? {
374            Expr::Number(number) => number.canonical.parse::<usize>().map_err(|_| {
375                prolog_eval_error(format!("expected usize, found {}", number.canonical))
376            }),
377            Expr::String(text) => text
378                .parse::<usize>()
379                .map_err(|_| prolog_eval_error(format!("expected usize, found {text}"))),
380            _ => Err(prolog_eval_error("expected usize value")),
381        },
382    }
383}
384
385fn unquote(expr: &Expr) -> Expr {
386    match expr {
387        Expr::Quote {
388            mode: QuoteMode::Quote,
389            expr,
390        } => (**expr).clone(),
391        other => other.clone(),
392    }
393}
394
395fn prolog_consult_path(cx: &mut Cx, db: &mut LogicDb, path: &str) -> Result<usize> {
396    cx.require(&logic_consult_file_capability())?;
397    let bytes = fs::read(path).map_err(|err| prolog_eval_error(err.to_string()))?;
398    let codec = codec_for_path(path);
399    let expr = decode_with_codec(
400        cx,
401        &codec,
402        match codec.name.as_ref() {
403            "binary" | "binary-base64" => Input::Bytes(bytes),
404            _ => Input::Text(
405                String::from_utf8(bytes).map_err(|err| prolog_eval_error(err.to_string()))?,
406            ),
407        },
408        ReadPolicy::default(),
409    )?;
410    prolog_consult_expr(db, expr)
411}
412
413fn prolog_consult_expr(db: &mut LogicDb, expr: Expr) -> Result<usize> {
414    match expr {
415        Expr::List(items) => {
416            let mut count = 0usize;
417            for item in items {
418                db.assert_clause_expr(item)?;
419                count += 1;
420            }
421            Ok(count)
422        }
423        other => {
424            db.assert_clause_expr(other)?;
425            Ok(1)
426        }
427    }
428}
429
430fn codec_for_path(path: &str) -> Symbol {
431    match Path::new(path)
432        .extension()
433        .and_then(|extension| extension.to_str())
434        .unwrap_or_default()
435    {
436        "simlogicb64" | "simb64" => Symbol::qualified("codec", "binary-base64"),
437        "json" => Symbol::qualified("codec", "json"),
438        "alg" => Symbol::qualified("codec", "algol"),
439        "slb8" => Symbol::qualified("codec", "binary"),
440        _ => Symbol::qualified("codec", "lisp"),
441    }
442}
443
444fn prolog_eval_error(message: impl Into<String>) -> Error {
445    Error::Eval(message.into())
446}