Orchid/orchid
1
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

September-october commit

Browse Source 
- manual parser
- stl refinements
- all language constructs are now Send
This commit is contained in:
Lawrence Bethlenfalvy
2023-10-11 18:27:50 +01:00
parent 56679dcc01
commit 86e520e8b8
127 changed files with 1666 additions and 1872 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
src/systems/assertion_error.rs
View File

@@ -1,41 +0,0 @@
use std::fmt::Display;
use std::rc::Rc;
use crate::foreign::ExternError;
use crate::Location;
/// Some expectation (usually about the argument types of a function) did not
/// hold.
#[derive(Clone)]
pub struct AssertionError {
location: Location,
message: &'static str,
}
impl AssertionError {
/// Construct, upcast and wrap in a Result that never succeeds for easy
/// short-circuiting
pub fn fail<T>(
location: Location,
message: &'static str,
) -> Result<T, Rc<dyn ExternError>> {
return Err(Self::ext(location, message));
}
/// Construct and upcast to [ExternError]
pub fn ext(location: Location, message: &'static str) -> Rc<dyn ExternError> {
return Self { location, message }.into_extern();
}
}
impl Display for AssertionError {
fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
write!(f, "Error: expected {}", self.message)?;
if self.location != Location::Unknown {
write!(f, " at {}", self.location)?;
}
Ok(())
}
}
impl ExternError for AssertionError {}

2
src/systems/asynch/async.orc
View File

@@ -1,6 +1,6 @@
import std::panic
export const block_on := \action.\cont. (
export const block_on := \action. \cont. (
action cont
(\e.panic "unwrapped asynch call")
\c.yield

29
src/systems/asynch/system.rs
View File

@@ -4,6 +4,7 @@ use std::collections::VecDeque;
use std::fmt::{Debug, Display};
use std::rc::Rc;
use std::sync::mpsc::Sender;
use std::sync::{Arc, Mutex};
use std::time::Duration;
use hashbrown::HashMap;
@@ -17,23 +18,30 @@ use crate::interpreted::{Clause, ExprInst};
use crate::interpreter::HandlerTable;
use crate::pipeline::file_loader::embed_to_map;
use crate::systems::codegen::call;
use crate::systems::stl::Boolean;
use crate::utils::poller::{PollEvent, Poller};
use crate::utils::unwrap_or;
use crate::{ConstTree, Interner};
#[derive(Debug, Clone)]
struct Timer {
recurring: Boolean,
recurring: bool,
delay: NotNan<f64>,
}
pub fn set_timer(recurring: Boolean, delay: NotNan<f64>) -> XfnResult<Clause> {
pub fn set_timer(recurring: bool, delay: NotNan<f64>) -> XfnResult<Clause> {
Ok(init_cps(2, Timer { recurring, delay }))
}
#[derive(Clone)]
struct CancelTimer(Rc<dyn Fn()>);
struct CancelTimer(Arc<Mutex<dyn Fn() + Send>>);
impl CancelTimer {
pub fn new(f: impl Fn() + Send + 'static) -> Self {
Self(Arc::new(Mutex::new(f)))
}
pub fn cancel(&self) {
self.0.lock().unwrap()()
}
}
impl Debug for CancelTimer {
fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
write!(f, "opaque cancel operation")
@@ -134,17 +142,16 @@ impl<'a> IntoSystem<'a> for AsynchSystem<'a> {
let mut polly = polly.borrow_mut();
let (timeout, action, cont) = t.unpack2();
let duration = Duration::from_secs_f64(*timeout.delay);
let cancel_timer = if timeout.recurring.0 {
CancelTimer(Rc::new(polly.set_interval(duration, action)))
} else {
CancelTimer(Rc::new(polly.set_timeout(duration, action)))
let cancel_timer = match timeout.recurring {
true => CancelTimer::new(polly.set_interval(duration, action)),
false => CancelTimer::new(polly.set_timeout(duration, action)),
};
Ok(call(cont, [init_cps(1, cancel_timer).wrap()]).wrap())
}
});
handler_table.register(move |t: Box<CPSBox<CancelTimer>>| {
let (command, cont) = t.unpack1();
command.0.as_ref()();
command.cancel();
Ok(cont)
});
handler_table.register({
@@ -165,7 +172,7 @@ impl<'a> IntoSystem<'a> for AsynchSystem<'a> {
PollEvent::Event(ev) => {
let handler = (handlers.get_mut(&ev.as_ref().type_id()))
.unwrap_or_else(|| {
panic!("Unhandled messgae type: {:?}", ev.type_id())
panic!("Unhandled messgae type: {:?}", (*ev).type_id())
});
let events = handler(ev);
// we got new microtasks
@@ -181,6 +188,8 @@ impl<'a> IntoSystem<'a> for AsynchSystem<'a> {
});
System {
name: vec!["system".to_string(), "asynch".to_string()],
lexer_plugin: None,
line_parser: None,
constants: ConstTree::namespace(
[i.i("system"), i.i("async")],
ConstTree::tree([

67
src/systems/cast_exprinst.rs
View File

@@ -1,67 +0,0 @@
//! Utility functions that operate on literals. Because of the parallel locked
//! nature of [ExprInst], returning a reference to [Literal] is not possible.
use std::rc::Rc;
use ordered_float::NotNan;
use super::assertion_error::AssertionError;
use crate::foreign::{Atom, ExternError};
use crate::interpreted::{Clause, Expr, TryFromExprInst};
use crate::representations::interpreted::ExprInst;
use crate::representations::{Literal, OrcString};
use crate::{Location, Primitive};
/// [ExprInst::get_literal] except the error is mapped to an [ExternError]
pub fn get_literal(
exi: ExprInst,
) -> Result<(Literal, Location), Rc<dyn ExternError>> {
(exi.get_literal()).map_err(|exi| {
eprintln!("failed to get literal from {:?}", exi.expr().clause);
AssertionError::ext(exi.location(), "literal")
})
}
// ######## Automatically ########
impl TryFromExprInst for Literal {
fn from_exi(exi: ExprInst) -> Result<Self, Rc<dyn ExternError>> {
get_literal(exi).map(|(l, _)| l)
}
}
impl TryFromExprInst for OrcString {
fn from_exi(exi: ExprInst) -> Result<Self, Rc<dyn ExternError>> {
match get_literal(exi)? {
(Literal::Str(s), _) => Ok(s),
(_, location) => AssertionError::fail(location, "string"),
}
}
}
impl TryFromExprInst for u64 {
fn from_exi(exi: ExprInst) -> Result<Self, Rc<dyn ExternError>> {
match get_literal(exi)? {
(Literal::Uint(u), _) => Ok(u),
(_, location) => AssertionError::fail(location, "uint"),
}
}
}
impl TryFromExprInst for NotNan<f64> {
fn from_exi(exi: ExprInst) -> Result<Self, Rc<dyn ExternError>> {
match get_literal(exi)? {
(Literal::Num(n), _) => Ok(n),
(_, location) => AssertionError::fail(location, "float"),
}
}
}
impl TryFromExprInst for Atom {
fn from_exi(exi: ExprInst) -> Result<Self, Rc<dyn ExternError>> {
let Expr { clause, location } = exi.expr_val();
match clause {
Clause::P(Primitive::Atom(a)) => Ok(a),
_ => AssertionError::fail(location, "atom"),
}
}
}

4
src/systems/codegen.rs
View File

@@ -39,11 +39,11 @@ pub fn tuple(data: impl IntoIterator<Item = ExprInst>) -> Clause {
#[cfg(test)]
mod test {
use crate::systems::codegen::tuple;
use crate::{systems::codegen::tuple, foreign::Atomic};
#[test]
fn tuple_printer() {
println!("Binary tuple: {}", tuple([0.into(), 1.into()]))
println!("Binary tuple: {}", tuple([0usize.atom_exi(), 1usize.atom_exi()]))
}
}

15
src/systems/directfs/commands.rs
View File

@@ -8,24 +8,27 @@ use itertools::Itertools;
use super::osstring::os_string_lib;
use crate::ddispatch::Responder;
use crate::error::RuntimeError;
use crate::facade::{IntoSystem, System};
use crate::foreign::cps_box::{init_cps, CPSBox};
use crate::foreign::{
xfn_1ary, xfn_2ary, Atomic, AtomicReturn, InertAtomic, XfnResult,
xfn_1ary, xfn_2ary, Atomic, AtomicReturn, InertAtomic, StrictEq, XfnResult,
};
use crate::interpreted::{Clause, ExprInst};
use crate::interpreter::HandlerTable;
use crate::systems::codegen::{call, list, opt, tuple};
use crate::systems::io::{wrap_io_error, Source};
use crate::systems::scheduler::{SeqScheduler, SharedHandle};
use crate::systems::stl::Boolean;
use crate::systems::RuntimeError;
use crate::utils::unwrap_or;
use crate::ConstTree;
#[derive(Debug, Clone)]
pub struct CurrentDir;
impl Responder for CurrentDir {}
impl StrictEq for CurrentDir {
// never appears in macros
fn strict_eq(&self, _: &dyn std::any::Any) -> bool { false }
}
impl Atomic for CurrentDir {
fn as_any(self: Box<Self>) -> Box<dyn std::any::Any> { self }
fn as_any_ref(&self) -> &dyn std::any::Any { self }
@@ -95,7 +98,7 @@ fn read_dir(sched: &SeqScheduler, cmd: CPSBox<ReadDirCmd>) -> ExprInst {
Err(e) => vec![call(fail, [wrap_io_error(e)]).wrap()],
Ok(os_namev) => {
let converted = (os_namev.into_iter())
.map(|(n, d)| Ok(tuple([n.atom_exi(), Boolean(d).atom_exi()]).wrap()))
.map(|(n, d)| Ok(tuple([n.atom_exi(), d.atom_exi()]).wrap()))
.collect::<Result<Vec<_>, Clause>>();
match converted {
Err(e) => vec![call(fail, [e.wrap()]).wrap()],
@@ -115,7 +118,7 @@ pub fn write_file(sched: &SeqScheduler, cmd: CPSBox<WriteFile>) -> ExprInst {
|file, _| match file {
Err(e) => vec![call(fail, [wrap_io_error(e)]).wrap()],
Ok(f) => {
let handle = SharedHandle::wrap(Box::new(f) as Box<dyn Write>);
let handle = SharedHandle::wrap(Box::new(f) as Box<dyn Write + Send>);
vec![call(succ, [handle.atom_exi()]).wrap()]
},
},
@@ -180,6 +183,8 @@ impl IntoSystem<'static> for DirectFS {
name: ["system", "directfs"].into_iter().map_into().collect(),
code: HashMap::new(),
prelude: Vec::new(),
lexer_plugin: None,
line_parser: None,
constants: ConstTree::namespace(
[i.i("system"), i.i("directfs")],
ConstTree::tree([

15
src/systems/io/bindings.rs
View File

@@ -1,13 +1,13 @@
use super::flow::IOCmdHandlePack;
use super::instances::{BRead, ReadCmd, SRead, Sink, Source, WriteCmd};
use crate::error::RuntimeError;
use crate::foreign::cps_box::init_cps;
use crate::foreign::{xfn_1ary, xfn_2ary, Atom, Atomic, XfnResult};
use crate::foreign::{xfn_1ary, xfn_2ary, Atomic, XfnResult, Atom};
use crate::interpreted::Clause;
use crate::representations::OrcString;
use crate::systems::scheduler::SharedHandle;
use crate::systems::stl::Binary;
use crate::systems::RuntimeError;
use crate::{ast, ConstTree, Interner, Primitive};
use crate::{ConstTree, Interner, ast};
type WriteHandle = SharedHandle<Sink>;
type ReadHandle = SharedHandle<Source>;
@@ -21,11 +21,11 @@ pub fn read_line(handle: ReadHandle) -> XfnResult<Clause> {
pub fn read_bin(handle: ReadHandle) -> XfnResult<Clause> {
Ok(init_cps(3, IOCmdHandlePack { handle, cmd: ReadCmd::RBytes(BRead::All) }))
}
pub fn read_bytes(handle: ReadHandle, n: u64) -> XfnResult<Clause> {
let cmd = ReadCmd::RBytes(BRead::N(n.try_into().unwrap()));
pub fn read_bytes(handle: ReadHandle, n: usize) -> XfnResult<Clause> {
let cmd = ReadCmd::RBytes(BRead::N(n));
Ok(init_cps(3, IOCmdHandlePack { cmd, handle }))
}
pub fn read_until(handle: ReadHandle, pattern: u64) -> XfnResult<Clause> {
pub fn read_until(handle: ReadHandle, pattern: usize) -> XfnResult<Clause> {
let delim = pattern.try_into().map_err(|_| {
let msg = "greater than 255".to_string();
RuntimeError::ext(msg, "converting number to byte")
@@ -63,8 +63,7 @@ pub fn io_bindings<'a>(
std_streams
.into_iter()
.map(|(n, at)| {
let expr = ast::Clause::P(Primitive::Atom(Atom(at))).into_expr();
(i.i(n), ConstTree::Const(expr))
(i.i(n), ConstTree::clause(ast::Clause::Atom(Atom(at))))
})
.collect(),
),

16
src/systems/io/instances.rs
View File

@@ -7,7 +7,7 @@ use crate::interpreted::ExprInst;
use crate::systems::codegen::call;
use crate::systems::scheduler::{Canceller, SharedHandle};
use crate::systems::stl::Binary;
use crate::Literal;
use crate::OrcString;
/// Any type that we can read controlled amounts of data from
pub type Source = BufReader<Box<dyn Read + Send>>;
@@ -63,10 +63,14 @@ impl IOCmd for ReadCmd {
Self::RStr(sread) => {
let mut buf = String::new();
let sresult = match &sread {
SRead::All => stream.read_to_string(&mut buf),
SRead::Line => stream.read_line(&mut buf),
SRead::All => stream.read_to_string(&mut buf).map(|_| ()),
SRead::Line => stream.read_line(&mut buf).map(|_| {
if buf.ends_with('\n') {
buf.pop();
}
}),
};
ReadResult::RStr(sread, sresult.map(|_| buf))
ReadResult::RStr(sread, sresult.map(|()| buf))
},
}
}
@@ -88,14 +92,14 @@ impl ReadResult {
vec![call(succ, [arg]).wrap()]
},
ReadResult::RStr(_, Ok(text)) => {
vec![call(succ, [Literal::Str(text.into()).into()]).wrap()]
vec![call(succ, [OrcString::from(text).atom_exi()]).wrap()]
},
}
}
}
/// Function to convert [io::Error] to Orchid data
pub fn wrap_io_error(_e: io::Error) -> ExprInst { Literal::Uint(0u64).into() }
pub fn wrap_io_error(_e: io::Error) -> ExprInst { 0usize.atom_exi() }
/// Writing command (string or binary)
#[derive(Debug, Clone, PartialEq, Eq, Hash)]

4
src/systems/io/io.orc
View File

@@ -2,7 +2,7 @@ import std::panic
import system::io
import system::async::yield
export const print := \text.\ok. (
export const print := \text. \ok. (
io::write_str io::stdout text
(io::flush io::stdout
ok
@@ -13,7 +13,7 @@ export const print := \text.\ok. (
\_. yield
)
export const println := \line.\ok. (
export const println := \line. \ok. (
print (line ++ "\n") ok
)

2
src/systems/io/service.rs
View File

@@ -113,6 +113,8 @@ impl<'a, ST: IntoIterator<Item = (&'a str, Stream)>> IntoSystem<'static>
name: None,
}]),
}],
lexer_plugin: None,
line_parser: None,
}
}
}

6
src/systems/mod.rs
View File

@@ -1,13 +1,7 @@
//! Constants exposed to usercode by the interpreter
mod assertion_error;
pub mod asynch;
pub mod cast_exprinst;
pub mod codegen;
pub mod directfs;
pub mod io;
mod runtime_error;
pub mod scheduler;
pub mod stl;
pub use assertion_error::AssertionError;
pub use runtime_error::RuntimeError;

35
src/systems/runtime_error.rs
View File

@@ -1,35 +0,0 @@
use std::fmt::Display;
use std::rc::Rc;
use crate::foreign::ExternError;
/// Some external event prevented the operation from succeeding
#[derive(Clone)]
pub struct RuntimeError {
message: String,
operation: &'static str,
}
impl RuntimeError {
/// Construct, upcast and wrap in a Result that never succeeds for easy
/// short-circuiting
pub fn fail<T>(
message: String,
operation: &'static str,
) -> Result<T, Rc<dyn ExternError>> {
return Err(Self { message, operation }.into_extern());
}
/// Construct and upcast to [ExternError]
pub fn ext(message: String, operation: &'static str) -> Rc<dyn ExternError> {
return Self { message, operation }.into_extern();
}
}
impl Display for RuntimeError {
fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
write!(f, "Error while {}: {}", self.operation, self.message)
}
}
impl ExternError for RuntimeError {}

24
src/systems/scheduler/busy.rs
View File

@@ -7,14 +7,17 @@ use crate::interpreted::ExprInst;
pub type SyncResult<T> = (T, Box<dyn Any + Send>);
pub type SyncOperation<T> =
Box<dyn FnOnce(T, Canceller) -> SyncResult<T> + Send>;
pub type SyncOpResultHandler<T> =
Box<dyn FnOnce(T, Box<dyn Any + Send>, Canceller) -> (T, Vec<ExprInst>)>;
pub type SyncOpResultHandler<T> = Box<
dyn FnOnce(T, Box<dyn Any + Send>, Canceller) -> (T, Vec<ExprInst>)
+ Send,
>;
struct SyncQueueItem<T> {
cancelled: Canceller,
operation: SyncOperation<T>,
handler: SyncOpResultHandler<T>,
early_cancel: Box<dyn FnOnce(T) -> (T, Vec<ExprInst>)>,
early_cancel: Box<dyn FnOnce(T) -> (T, Vec<ExprInst>) + Send>,
}
pub enum NextItemReportKind<T> {
@@ -36,11 +39,14 @@ pub struct NextItemReport<T> {
pub struct BusyState<T> {
handler: SyncOpResultHandler<T>,
queue: VecDeque<SyncQueueItem<T>>,
seal: Option<Box<dyn FnOnce(T) -> Vec<ExprInst>>>,
seal: Option<Box<dyn FnOnce(T) -> Vec<ExprInst> + Send>>,
}
impl<T> BusyState<T> {
pub fn new<U: 'static + Send>(
handler: impl FnOnce(T, U, Canceller) -> (T, Vec<ExprInst>) + 'static,
handler: impl FnOnce(T, U, Canceller) -> (T, Vec<ExprInst>)
+ Send
+ 'static,
) -> Self {
BusyState {
handler: Box::new(|t, payload, cancel| {
@@ -59,8 +65,8 @@ impl<T> BusyState<T> {
pub fn enqueue<U: 'static + Send>(
&mut self,
operation: impl FnOnce(T, Canceller) -> (T, U) + Send + 'static,
handler: impl FnOnce(T, U, Canceller) -> (T, Vec<ExprInst>) + 'static,
early_cancel: impl FnOnce(T) -> (T, Vec<ExprInst>) + 'static,
handler: impl FnOnce(T, U, Canceller) -> (T, Vec<ExprInst>) + Send + 'static,
early_cancel: impl FnOnce(T) -> (T, Vec<ExprInst>) + Send + 'static,
) -> Option<Canceller> {
if self.seal.is_some() {
return None;
@@ -81,7 +87,7 @@ impl<T> BusyState<T> {
Some(cancelled)
}
pub fn seal(&mut self, recipient: impl FnOnce(T) -> Vec<ExprInst> + 'static) {
pub fn seal(&mut self, recipient: impl FnOnce(T) -> Vec<ExprInst> + Send + 'static) {
assert!(self.seal.is_none(), "Already sealed");
self.seal = Some(Box::new(recipient))
}
@@ -101,7 +107,7 @@ impl<T> BusyState<T> {
if candidate.cancelled.is_cancelled() {
let ret = (candidate.early_cancel)(instance);
instance = ret.0;
events.extend(ret.1.into_iter());
events.extend(ret.1);
} else {
break candidate;
}

49
src/systems/scheduler/system.rs
View File

@@ -2,6 +2,7 @@ use std::any::{type_name, Any};
use std::cell::RefCell;
use std::fmt::Debug;
use std::rc::Rc;
use std::sync::{Arc, Mutex};
use hashbrown::HashMap;
use itertools::Itertools;
@@ -9,14 +10,13 @@ use trait_set::trait_set;
use super::busy::{BusyState, NextItemReportKind};
use super::Canceller;
use crate::error::AssertionError;
use crate::facade::{IntoSystem, System};
use crate::foreign::cps_box::{init_cps, CPSBox};
use crate::foreign::{xfn_1ary, InertAtomic, XfnResult};
use crate::interpreted::{Clause, ExprInst};
use crate::interpreter::HandlerTable;
use crate::systems::asynch::{AsynchSystem, MessagePort};
use crate::systems::stl::Boolean;
use crate::systems::AssertionError;
use crate::utils::ddispatch::Request;
use crate::utils::thread_pool::ThreadPool;
use crate::utils::{take_with_output, unwrap_or, IdMap};
@@ -47,17 +47,17 @@ pub enum SharedState {
/// A shared handle for a resource of type `T` that can be used with a
/// [SeqScheduler] to execute mutating operations one by one in worker threads.
pub struct SharedHandle<T>(Rc<RefCell<SharedResource<T>>>);
pub struct SharedHandle<T>(Arc<Mutex<SharedResource<T>>>);
impl<T> SharedHandle<T> {
/// Wrap a value to be accessible to a [SeqScheduler].
pub fn wrap(t: T) -> Self {
Self(Rc::new(RefCell::new(SharedResource::Free(t))))
Self(Arc::new(Mutex::new(SharedResource::Free(t))))
}
/// Check the state of the handle
pub fn state(&self) -> SharedState {
match &*self.0.as_ref().borrow() {
match &*self.0.lock().unwrap() {
SharedResource::Busy(b) if b.is_sealed() => SharedState::Sealed,
SharedResource::Busy(_) => SharedState::Busy,
SharedResource::Free(_) => SharedState::Free,
@@ -70,7 +70,7 @@ impl<T> SharedHandle<T> {
/// sense as eg. an optimization. You can return the value after processing
/// via [SyncHandle::untake].
pub fn take(&self) -> Option<T> {
take_with_output(&mut *self.0.as_ref().borrow_mut(), |state| match state {
take_with_output(&mut *self.0.lock().unwrap(), |state| match state {
SharedResource::Free(t) => (SharedResource::Taken, Some(t)),
_ => (state, None),
})
@@ -80,10 +80,13 @@ impl<T> SharedHandle<T> {
/// is to return values synchronously after they have been removed with
/// [SyncHandle::untake].
pub fn untake(&self, value: T) -> Result<(), T> {
take_with_output(&mut *self.0.as_ref().borrow_mut(), |state| match state {
SharedResource::Taken => (SharedResource::Free(value), Ok(())),
_ => (state, Err(value)),
})
take_with_output(
&mut *self.0.lock().unwrap(),
|state| match state {
SharedResource::Taken => (SharedResource::Free(value), Ok(())),
_ => (state, Err(value)),
},
)
}
}
impl<T> Clone for SharedHandle<T> {
@@ -97,12 +100,12 @@ impl<T> Debug for SharedHandle<T> {
.finish()
}
}
impl<T: 'static> InertAtomic for SharedHandle<T> {
impl<T: Send + 'static> InertAtomic for SharedHandle<T> {
fn type_str() -> &'static str { "a SharedHandle" }
fn respond(&self, mut request: Request) {
request.serve_with(|| {
let this = self.clone();
TakeCmd(Rc::new(move |sch| {
TakeCmd(Arc::new(move |sch| {
let _ = sch.seal(this.clone(), |_| Vec::new());
}))
})
@@ -110,7 +113,7 @@ impl<T: 'static> InertAtomic for SharedHandle<T> {
}
#[derive(Clone)]
pub struct TakeCmd(pub Rc<dyn Fn(SeqScheduler)>);
pub struct TakeCmd(pub Arc<dyn Fn(SeqScheduler) + Send + Sync>);
impl Debug for TakeCmd {
fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
write!(f, "A command to drop a shared resource")
@@ -134,8 +137,8 @@ pub fn take_and_drop(x: ExprInst) -> XfnResult<Clause> {
}
}
pub fn is_taken_error(x: ExprInst) -> XfnResult<Boolean> {
Ok(Boolean(x.downcast::<SealedOrTaken>().is_ok()))
pub fn is_taken_error(x: ExprInst) -> XfnResult<bool> {
Ok(x.downcast::<SealedOrTaken>().is_ok())
}
trait_set! {
@@ -195,11 +198,11 @@ impl SeqScheduler {
pub fn schedule<T: Send + 'static, U: Send + 'static>(
&self,
handle: SharedHandle<T>,
operation: impl FnOnce(T, Canceller) -> (T, U) + Send + 'static,
handler: impl FnOnce(T, U, Canceller) -> (T, Vec<ExprInst>) + 'static,
early_cancel: impl FnOnce(T) -> (T, Vec<ExprInst>) + 'static,
operation: impl FnOnce(T, Canceller) -> (T, U) + Sync + Send + 'static,
handler: impl FnOnce(T, U, Canceller) -> (T, Vec<ExprInst>) + Sync + Send + 'static,
early_cancel: impl FnOnce(T) -> (T, Vec<ExprInst>) + Sync + Send + 'static,
) -> Result<Canceller, SealedOrTaken> {
take_with_output(&mut *handle.0.as_ref().borrow_mut(), {
take_with_output(&mut *handle.0.lock().unwrap(), {
let handle = handle.clone();
|state| {
match state {
@@ -246,10 +249,10 @@ impl SeqScheduler {
pub fn seal<T>(
&self,
handle: SharedHandle<T>,
seal: impl FnOnce(T) -> Vec<ExprInst> + 'static,
seal: impl FnOnce(T) -> Vec<ExprInst> + Sync + Send + 'static,
) -> Result<Vec<ExprInst>, SealedOrTaken> {
take_with_output(
&mut *handle.0.as_ref().borrow_mut(),
&mut *handle.0.lock().unwrap(),
|state| match state {
SharedResource::Busy(mut b) if !b.is_sealed() => {
b.seal(seal);
@@ -281,7 +284,7 @@ impl SeqScheduler {
let (t, u): (T, U) =
*data.downcast().expect("This is associated by ID");
let handle2 = handle.clone();
take_with_output(&mut *handle.0.as_ref().borrow_mut(), |state| {
take_with_output(&mut *handle.0.lock().unwrap(), |state| {
let busy = unwrap_or! { state => SharedResource::Busy;
panic!("Handle with outstanding invocation must be busy")
};
@@ -329,6 +332,8 @@ impl IntoSystem<'static> for SeqScheduler {
prelude: Vec::new(),
code: HashMap::new(),
handlers,
lexer_plugin: None,
line_parser: None,
constants: ConstTree::namespace(
[i.i("system"), i.i("scheduler")],
ConstTree::tree([

77
src/systems/stl/bin.rs → src/systems/stl/binary.rs
View File

@@ -3,15 +3,16 @@ use std::sync::Arc;
use itertools::Itertools;
use super::Boolean;
use crate::error::RuntimeError;
use crate::foreign::{
xfn_1ary, xfn_2ary, xfn_3ary, xfn_4ary, Atomic, InertAtomic, XfnResult,
};
use crate::interpreted::Clause;
use crate::systems::codegen::{opt, tuple};
use crate::systems::RuntimeError;
use crate::utils::{iter_find, unwrap_or};
use crate::{ConstTree, Interner, Literal};
use crate::{ConstTree, Interner};
const INT_BYTES: usize = usize::BITS as usize / 8;
/// A block of binary data
#[derive(Clone, Hash, PartialEq, Eq)]
@@ -43,93 +44,86 @@ pub fn concatenate(a: Binary, b: Binary) -> XfnResult<Binary> {
}
/// Extract a subsection of the binary data
pub fn slice(s: Binary, i: u64, len: u64) -> XfnResult<Binary> {
if i + len < s.0.len() as u64 {
pub fn slice(s: Binary, i: usize, len: usize) -> XfnResult<Binary> {
if i + len < s.0.len() {
RuntimeError::fail(
"Byte index out of bounds".to_string(),
"indexing binary",
)?
}
let data = s.0[i as usize..i as usize + len as usize].to_vec();
Ok(Binary(Arc::new(data)))
Ok(Binary(Arc::new(s.0[i..i + len].to_vec())))
}
/// Return the index where the first argument first contains the second, if any
pub fn find(haystack: Binary, needle: Binary) -> XfnResult<Clause> {
let found = iter_find(haystack.0.iter(), needle.0.iter());
Ok(opt(found.map(|x| Literal::Uint(x as u64).into())))
Ok(opt(found.map(usize::atom_exi)))
}
/// Split binary data block into two smaller blocks
pub fn split(bin: Binary, i: u64) -> XfnResult<Clause> {
if bin.0.len() < i as usize {
pub fn split(bin: Binary, i: usize) -> XfnResult<Clause> {
if bin.0.len() < i {
RuntimeError::fail(
"Byte index out of bounds".to_string(),
"splitting binary",
)?
}
let (asl, bsl) = bin.0.split_at(i as usize);
Ok(tuple([
Binary(Arc::new(asl.to_vec())).atom_cls().into(),
Binary(Arc::new(bsl.to_vec())).atom_cls().into(),
]))
let (asl, bsl) = bin.0.split_at(i);
Ok(tuple([asl, bsl].map(|s| Binary(Arc::new(s.to_vec())).atom_exi())))
}
/// Read a number from a binary blob
pub fn get_num(
buf: Binary,
loc: u64,
size: u64,
is_le: Boolean,
) -> XfnResult<Literal> {
if buf.0.len() < (loc + size) as usize {
loc: usize,
size: usize,
is_le: bool,
) -> XfnResult<usize> {
if buf.0.len() < (loc + size) {
RuntimeError::fail(
"section out of range".to_string(),
"reading number from binary data",
)?
}
if 8 < size {
if INT_BYTES < size {
RuntimeError::fail(
"more than 8 bytes provided".to_string(),
"more than std::bin::int_bytes bytes provided".to_string(),
"reading number from binary data",
)?
}
let mut data = [0u8; 8];
let section = &buf.0[loc as usize..(loc + size) as usize];
let num = if is_le.0 {
data[0..size as usize].copy_from_slice(section);
u64::from_le_bytes(data)
let mut data = [0u8; INT_BYTES];
let section = &buf.0[loc..(loc + size)];
let num = if is_le {
data[0..size].copy_from_slice(section);
usize::from_le_bytes(data)
} else {
data[8 - size as usize..].copy_from_slice(section);
u64::from_be_bytes(data)
data[INT_BYTES - size..].copy_from_slice(section);
usize::from_be_bytes(data)
};
Ok(Literal::Uint(num))
Ok(num)
}
/// Convert a number into a blob
pub fn from_num(size: u64, is_le: Boolean, data: u64) -> XfnResult<Binary> {
if size > 8 {
pub fn from_num(size: usize, is_le: bool, data: usize) -> XfnResult<Binary> {
if INT_BYTES < size {
RuntimeError::fail(
"more than 8 bytes requested".to_string(),
"more than std::bin::int_bytes bytes requested".to_string(),
"converting number to binary",
)?
}
let bytes = if is_le.0 {
data.to_le_bytes()[0..size as usize].to_vec()
} else {
data.to_be_bytes()[8 - size as usize..].to_vec()
let bytes = match is_le {
true => data.to_le_bytes()[0..size].to_vec(),
false => data.to_be_bytes()[8 - size..].to_vec(),
};
Ok(Binary(Arc::new(bytes)))
}
/// Detect the number of bytes in the blob
pub fn size(b: Binary) -> XfnResult<Literal> {
Ok(Literal::Uint(b.0.len() as u64))
}
pub fn size(b: Binary) -> XfnResult<usize> { Ok(b.0.len()) }
pub fn bin(i: &Interner) -> ConstTree {
ConstTree::tree([(
i.i("bin"),
i.i("binary"),
ConstTree::tree([
(i.i("concat"), ConstTree::xfn(xfn_2ary(concatenate))),
(i.i("slice"), ConstTree::xfn(xfn_3ary(slice))),
@@ -138,6 +132,7 @@ pub fn bin(i: &Interner) -> ConstTree {
(i.i("get_num"), ConstTree::xfn(xfn_4ary(get_num))),
(i.i("from_num"), ConstTree::xfn(xfn_3ary(from_num))),
(i.i("size"), ConstTree::xfn(xfn_1ary(size))),
(i.i("int_bytes"), ConstTree::atom(INT_BYTES)),
]),
)])
}

4
src/systems/stl/bool.orc
View File

@@ -1,8 +1,10 @@
export operators[ != == ]
export ::(!=, ==)
export const not := \bool. if bool then false else true
macro ...$a != ...$b =0x3p36=> (not (...$a == ...$b))
macro ...$a == ...$b =0x3p36=> (equals (...$a) (...$b))
export macro ...$a and ...$b =0x4p36=> (ifthenelse (...$a) (...$b) false)
export macro ...$a or ...$b =0x4p36=> (ifthenelse (...$a) true (...$b))
export macro if ...$cond then ...$true else ...$false:1 =0x1p84=> (
ifthenelse (...$cond) (...$true) (...$false)
)

52
src/systems/stl/bool.rs
View File

@@ -1,26 +1,17 @@
use crate::foreign::{xfn_1ary, xfn_2ary, InertAtomic, XfnResult};
use crate::foreign::{xfn_1ary, xfn_2ary, XfnResult, Atom};
use crate::interner::Interner;
use crate::representations::interpreted::Clause;
use crate::systems::AssertionError;
use crate::{ConstTree, Literal, Location};
use crate::error::AssertionError;
use crate::{ConstTree, Location, OrcString};
/// Booleans exposed to Orchid
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
pub struct Boolean(pub bool);
impl InertAtomic for Boolean {
fn type_str() -> &'static str { "a boolean" }
}
impl From<bool> for Boolean {
fn from(value: bool) -> Self { Self(value) }
}
use super::Numeric;
/// Takes a boolean and two branches, runs the first if the bool is true, the
/// second if it's false.
// Even though it's a ternary function, IfThenElse is implemented as an unary
// foreign function, as the rest of the logic can be defined in Orchid.
pub fn if_then_else(b: Boolean) -> XfnResult<Clause> {
Ok(match b.0 {
pub fn if_then_else(b: bool) -> XfnResult<Clause> {
Ok(match b {
true => Clause::pick(Clause::constfn(Clause::LambdaArg)),
false => Clause::constfn(Clause::pick(Clause::LambdaArg)),
})
@@ -29,16 +20,25 @@ pub fn if_then_else(b: Boolean) -> XfnResult<Clause> {
/// Compares the inner values if
///
/// - both are string,
/// - both are bool,
/// - both are either uint or num
pub fn equals(a: Literal, b: Literal) -> XfnResult<Boolean> {
Ok(Boolean::from(match (a, b) {
(Literal::Str(s1), Literal::Str(s2)) => s1 == s2,
(Literal::Num(n1), Literal::Num(n2)) => n1 == n2,
(Literal::Uint(i1), Literal::Uint(i2)) => i1 == i2,
(Literal::Num(n1), Literal::Uint(u1)) => *n1 == (u1 as f64),
(Literal::Uint(u1), Literal::Num(n1)) => *n1 == (u1 as f64),
(..) => AssertionError::fail(Location::Unknown, "the expected type")?,
}))
pub fn equals(a: Atom, b: Atom) -> XfnResult<bool> {
let (a, b) = match (a.try_downcast::<OrcString>(), b.try_downcast::<OrcString>()) {
(Ok(a), Ok(b)) => return Ok(a == b),
(Err(a), Err(b)) => (a, b),
_ => return Ok(false),
};
match (a.request::<Numeric>(), b.request::<Numeric>()) {
(Some(a), Some(b)) => return Ok(a.as_float() == b.as_float()),
(None, None) => (),
_ => return Ok(false),
};
match (a.try_downcast::<bool>(), b.try_downcast::<bool>()) {
(Ok(a), Ok(b)) => return Ok(a == b),
(Err(_), Err(_)) => (),
_ => return Ok(false),
};
AssertionError::fail(Location::Unknown, "the expected type")
}
pub fn bool(i: &Interner) -> ConstTree {
@@ -47,8 +47,8 @@ pub fn bool(i: &Interner) -> ConstTree {
ConstTree::tree([
(i.i("ifthenelse"), ConstTree::xfn(xfn_1ary(if_then_else))),
(i.i("equals"), ConstTree::xfn(xfn_2ary(equals))),
(i.i("true"), ConstTree::atom(Boolean(true))),
(i.i("false"), ConstTree::atom(Boolean(false))),
(i.i("true"), ConstTree::atom(true)),
(i.i("false"), ConstTree::atom(false)),
]),
)])
}

61
src/systems/stl/conv.rs
View File

@@ -1,48 +1,45 @@
use chumsky::Parser;
use ordered_float::NotNan;
use super::ArithmeticError;
use crate::foreign::{xfn_1ary, ExternError, XfnResult};
use super::Numeric;
use crate::error::AssertionError;
use crate::foreign::{xfn_1ary, Atom, XfnResult};
use crate::interner::Interner;
use crate::parse::{float_parser, int_parser};
use crate::systems::AssertionError;
use crate::{ConstTree, Literal, Location};
use crate::parse::parse_num;
use crate::{ConstTree, Location, OrcString};
fn to_numeric(a: Atom) -> XfnResult<Numeric> {
if let Some(n) = a.request::<Numeric>() {
return Ok(n);
}
if let Some(s) = a.request::<OrcString>() {
return parse_num(s.as_str())
.map_err(|_| AssertionError::ext(Location::Unknown, "number syntax"));
}
AssertionError::fail(Location::Unknown, "string or number")
}
/// parse a number. Accepts the same syntax Orchid does.
pub fn to_float(l: Literal) -> XfnResult<Literal> {
match l {
Literal::Str(s) => float_parser()
.parse(s.as_str())
.map(Literal::Num)
.map_err(|_| AssertionError::ext(Location::Unknown, "float syntax")),
n @ Literal::Num(_) => Ok(n),
Literal::Uint(i) => NotNan::new(i as f64)
.map(Literal::Num)
.map_err(|_| ArithmeticError::NaN.into_extern()),
}
pub fn to_float(a: Atom) -> XfnResult<NotNan<f64>> {
to_numeric(a).map(|n| n.as_float())
}
/// Parse an unsigned integer. Accepts the same formats Orchid does. If the
/// input is a number, floors it.
pub fn to_uint(l: Literal) -> XfnResult<Literal> {
match l {
Literal::Str(s) => int_parser()
.parse(s.as_str())
.map(Literal::Uint)
.map_err(|_| AssertionError::ext(Location::Unknown, "int syntax")),
Literal::Num(n) => Ok(Literal::Uint(n.floor() as u64)),
i @ Literal::Uint(_) => Ok(i),
}
pub fn to_uint(a: Atom) -> XfnResult<usize> {
to_numeric(a).map(|n| match n {
Numeric::Float(f) => f.floor() as usize,
Numeric::Uint(i) => i,
})
}
/// Convert a literal to a string using Rust's conversions for floats, chars and
/// uints respectively
pub fn to_string(l: Literal) -> XfnResult<Literal> {
Ok(match l {
Literal::Uint(i) => Literal::Str(i.to_string().into()),
Literal::Num(n) => Literal::Str(n.to_string().into()),
s @ Literal::Str(_) => s,
})
pub fn to_string(a: Atom) -> XfnResult<OrcString> {
a.try_downcast::<OrcString>()
.or_else(|e| e.try_downcast::<usize>().map(|i| i.to_string().into()))
.or_else(|e| e.try_downcast::<NotNan<f64>>().map(|i| i.to_string().into()))
.or_else(|e| e.try_downcast::<bool>().map(|i| i.to_string().into()))
.map_err(|_| AssertionError::ext(Location::Unknown, "string or number"))
}
pub fn conv(i: &Interner) -> ConstTree {

27
src/systems/stl/exit_status.rs Normal file
View File

@@ -0,0 +1,27 @@
use crate::foreign::{xfn_1ary, InertAtomic};
use crate::{ConstTree, Interner};
/// An Orchid equivalent to Rust's binary exit status model
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
pub enum ExitStatus {
/// unix exit code 0
Success,
/// unix exit code 1
Failure,
}
impl InertAtomic for ExitStatus {
fn type_str() -> &'static str { "ExitStatus" }
}
pub fn exit_status(i: &Interner) -> ConstTree {
let is_success = |es: ExitStatus| Ok(es == ExitStatus::Success);
ConstTree::namespace(
[i.i("exit_status")],
ConstTree::tree([
(i.i("success"), ConstTree::atom(ExitStatus::Success)),
(i.i("failure"), ConstTree::atom(ExitStatus::Failure)),
(i.i("is_success"), ConstTree::xfn(xfn_1ary(is_success))),
]),
)
}

6
src/systems/stl/fn.orc → src/systems/stl/functional.orc
View File

@@ -6,19 +6,19 @@ export const identity := \x.x
Apply the function to the given value. Can be used to assign a
concrete value in a cps assignment statement.
]--
export const pass := \val.\cont. cont val
export const pass := \val. \cont. cont val
--[
Apply the function to the given pair of values. Mainly useful to assign
a concrete pair of values in a cps multi-assignment statement
]--
export const pass2 := \a.\b.\cont. cont a b
export const pass2 := \a. \b. \cont. cont a b
--[
A function that returns the given value for any input. Also useful as a
"break" statement in a "do" block.
]--
export const return := \a. \b.a
export operators[$ |> =>]
export ::($, |>, =>)
macro ...$prefix $ ...$suffix:1 =0x1p38=> ...$prefix (...$suffix)
macro ...$prefix |> $fn ..$suffix:1 =0x2p32=> $fn (...$prefix) ..$suffix

4
src/systems/stl/known.orc
View File

@@ -1,3 +1 @@
export operators[ , ]
export const foo := \a.a
export ::[,]

37
src/systems/stl/list.orc
View File

@@ -1,13 +1,14 @@
import super::(option, fn::*, proc::*, loop::*, bool::*, known::*, num::*, tuple::*)
import super::option
import super::(functional::*, procedural::*, loop::*, bool::*, known::*, number::*, tuple::*)
const pair := \a.\b. \f. f a b
const pair := \a. \b. \f. f a b
-- Constructors
export const cons := \hd.\tl. option::some t[hd, tl]
export const cons := \hd. \tl. option::some t[hd, tl]
export const end := option::none
export const pop := \list.\default.\f. do{
export const pop := \list. \default. \f. do{
cps tuple = list default;
cps head, tail = tuple;
f head tail
@@ -19,7 +20,7 @@ export const pop := \list.\default.\f. do{
Fold each element into an accumulator using an `acc -> el -> acc`.
This evaluates the entire list, and is always tail recursive.
]--
export const fold := \list.\acc.\f. (
export const fold := \list. \acc. \f. (
loop_over (list, acc) {
cps head, list = pop list acc;
let acc = f acc head;
@@ -30,9 +31,9 @@ export const fold := \list.\acc.\f. (
Fold each element into an accumulator in reverse order.
This evaulates the entire list, and is never tail recursive.
]--
export const rfold := \list.\acc.\f. (
export const rfold := \list. \acc. \f. (
recursive r (list)
pop list acc \head.\tail.
pop list acc \head. \tail.
f (r tail) head
)
@@ -40,7 +41,7 @@ export const rfold := \list.\acc.\f. (
Fold each element into a shared element with an `el -> el -> el`.
This evaluates the entire list, and is never tail recursive.
]--
export const reduce := \list.\f. do{
export const reduce := \list. \f. do{
cps head, list = pop list option::none;
option::some $ fold list head f
}
@@ -49,8 +50,8 @@ export const reduce := \list.\f. do{
Return a new list that contains only the elements from the input list
for which the function returns true. This operation is lazy.
]--
export const filter := \list.\f. (
pop list end \head.\tail.
export const filter := \list. \f. (
pop list end \head. \tail.
if (f head)
then cons head (filter tail f)
else filter tail f
@@ -59,9 +60,9 @@ export const filter := \list.\f. (
--[
Transform each element of the list with an `el -> any`.
]--
export const map := \list.\f. (
export const map := \list. \f. (
recursive r (list)
pop list end \head.\tail.
pop list end \head. \tail.
cons (f head) (r tail)
)
@@ -69,7 +70,7 @@ export const map := \list.\f. (
Skip `n` elements from the list and return the tail
If `n` is not an integer, this returns `end`.
]--
export const skip := \foo.\n. (
export const skip := \foo. \n. (
loop_over (foo, n) {
cps _head, foo = if n == 0
then return foo
@@ -82,11 +83,11 @@ export const skip := \foo.\n. (
Return `n` elements from the list and discard the rest.
This operation is lazy.
]--
export const take := \list.\n. (
export const take := \list. \n. (
recursive r (list, n)
if n == 0
then end
else pop list end \head.\tail.
else pop list end \head. \tail.
cons head $ r tail $ n - 1
)
@@ -94,7 +95,7 @@ export const take := \list.\n. (
Return the `n`th element from the list.
This operation is tail recursive.
]--
export const get := \list.\n. (
export const get := \list. \n. (
loop_over (list, n) {
cps head, list = pop list option::none;
cps if n == 0
@@ -109,7 +110,7 @@ export const get := \list.\n. (
]--
export const enumerate := \list. (
recursive r (list, n = 0)
pop list end \head.\tail.
pop list end \head. \tail.
cons t[n, head] $ r tail $ n + 1
)
@@ -118,7 +119,7 @@ export const enumerate := \list. (
element on the return value of the next element with the tail passed to it.
The continuation is passed to the very last argument.
]--
export const chain := \list.\cont. loop_over (list) {
export const chain := \list. \cont. loop_over (list) {
cps head, list = pop list cont;
cps head;
}

16
src/systems/stl/loop.orc
View File

@@ -1,4 +1,6 @@
import super::proc::(;, do, =)
import super::procedural::*
import super::bool::*
import super::functional::(return, identity)
import super::known::*
--[
@@ -14,7 +16,7 @@ export const Y := \f.(\x.f (x x))(\x.f (x x))
non-tail recursion by using cps statements, but it's more ergonomic
than [Y] and more flexible than [std::list::fold].
To break out of the loop, use [std::fn::const] in a cps statement
To break out of the loop, use [std::fn::return] in a cps statement
]--
export macro loop_over (..$binds) {
...$body
@@ -35,6 +37,16 @@ macro parse_binds (...$item) =0x1p250=> (
()
)
-- while loop
export macro statement (
while ..$condition (..$binds) {
...$body
}
) $next =0x5p129=> loop_over (..$binds) {
cps if (..$condition) then identity else return $next;
...$body;
}
-- parse_bind converts items to pairs
macro parse_bind ($name) =0x1p250=> ($name bind_no_value)
macro parse_bind ($name = ...$value) =0x1p250=> ($name (...$value))

16
src/systems/stl/map.orc
View File

@@ -1,4 +1,4 @@
import super::(bool::*, fn::*, known::*, list, option, loop::*, proc::*)
import super::(bool::*, functional::*, known::*, list, option, loop::*, procedural::*)
import std::panic
-- utilities for using lists as pairs
@@ -17,7 +17,7 @@ export const snd := \l. (
-- constructors
export const empty := list::end
export const add := \m.\k.\v. (
export const add := \m. \k. \v. (
list::cons
list::new[k, v]
m
@@ -26,7 +26,7 @@ export const add := \m.\k.\v. (
-- queries
-- return the last occurrence of a key if exists
export const get := \m.\key. (
export const get := \m. \key. (
loop_over (m) {
cps record, m = list::pop m option::none;
cps if fst record == key
@@ -38,20 +38,20 @@ export const get := \m.\key. (
-- commands
-- remove one occurrence of a key
export const del := \m.\k. (
export const del := \m. \k. (
recursive r (m)
list::pop m list::end \head.\tail.
list::pop m list::end \head. \tail.
if fst head == k then tail
else list::cons head $ r tail
)
-- remove all occurrences of a key
export const delall := \m.\k. (
export const delall := \m. \k. (
list::filter m \record. fst record != k
)
-- replace at most one occurrence of a key
export const set := \m.\k.\v. (
export const set := \m. \k. \v. (
m
|> del k
|> add k v
@@ -60,7 +60,7 @@ export const set := \m.\k.\v. (
-- ensure that there's only one instance of each key in the map
export const normalize := \m. (
recursive r (m, normal=empty)
list::pop m normal \head.\tail.
list::pop m normal \head. \tail.
r tail $ set normal (fst head) (snd head)
)

14
src/systems/stl/mod.rs
View File

@@ -1,18 +1,18 @@
//! Basic types and their functions, frequently used tools with no environmental
//! dependencies.
mod arithmetic_error;
mod bin;
mod binary;
mod bool;
mod conv;
mod inspect;
mod num;
mod number;
mod panic;
mod state;
mod stl_system;
mod str;
mod string;
mod exit_status;
pub use arithmetic_error::ArithmeticError;
pub use bin::Binary;
pub use num::Numeric;
pub use binary::Binary;
pub use number::Numeric;
pub use stl_system::StlConfig;
pub use self::bool::Boolean;
pub use exit_status::ExitStatus;

7
src/systems/stl/num.orc
View File

@@ -1,7 +0,0 @@
export operators[ + - * % / ]
macro ...$a + ...$b =0x2p36=> (add (...$a) (...$b))
macro ...$a:1 - ...$b =0x2p36=> (subtract (...$a) (...$b))
macro ...$a * ...$b =0x1p36=> (multiply (...$a) (...$b))
macro ...$a:1 % ...$b =0x1p36=> (remainder (...$a) (...$b))
macro ...$a:1 / ...$b =0x1p36=> (divide (...$a) (...$b))

16
src/systems/stl/number.orc Normal file
View File

@@ -0,0 +1,16 @@
import super::bool::*
export ::(+, -, [*], %, /, <, >, <=, >=)
const less_than_or_equal := \a. \b. a < b or a == b
macro ...$a + ...$b =0x2p36=> (add (...$a) (...$b))
macro ...$a:1 - ...$b =0x2p36=> (subtract (...$a) (...$b))
macro ...$a * ...$b =0x1p36=> (multiply (...$a) (...$b))
macro ...$a:1 % ...$b =0x1p36=> (remainder (...$a) (...$b))
macro ...$a:1 / ...$b =0x1p36=> (divide (...$a) (...$b))
macro ...$a:1 < ...$b =0x3p36=> (less_than (...$a) (...$b))
macro ...$a:1 > ...$b =0x3p36=> ((...$b) < (...$a))
macro ...$a:1 <= ...$b =0x3p36=> (less_than_or_equal (...$a) (...$b))
macro ...$a:1 >= ...$b =0x3p36=> ((...$b) <= (...$a))

83
src/systems/stl/num.rs → src/systems/stl/number.rs
View File

@@ -3,13 +3,11 @@ use std::rc::Rc;
use ordered_float::NotNan;
use super::ArithmeticError;
use crate::foreign::{xfn_2ary, ExternError, ToClause, XfnResult};
use crate::error::AssertionError;
use crate::foreign::{xfn_2ary, ExternError, ToClause, XfnResult, Atomic};
use crate::interpreted::TryFromExprInst;
use crate::representations::interpreted::{Clause, ExprInst};
use crate::representations::{Literal, Primitive};
use crate::systems::cast_exprinst::get_literal;
use crate::systems::AssertionError;
use crate::{ConstTree, Interner};
use crate::{ConstTree, Interner, Location};
// region: Numeric, type to handle floats and uints together
@@ -17,24 +15,34 @@ use crate::{ConstTree, Interner};
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
pub enum Numeric {
/// A nonnegative integer such as a size, index or count
Uint(u64),
Uint(usize),
/// A float other than NaN. Orchid has no silent errors
Num(NotNan<f64>),
Float(NotNan<f64>),
}
impl Numeric {
fn as_f64(&self) -> f64 {
/// Return the enclosed float, or cast the enclosed int to a float
pub fn as_f64(&self) -> f64 {
match self {
Numeric::Num(n) => **n,
Numeric::Float(n) => **n,
Numeric::Uint(i) => *i as f64,
}
}
/// Returns the enclosed [NotNan], or casts and wraps the enclosed int
pub fn as_float(&self) -> NotNan<f64> {
match self {
Numeric::Float(n) => *n,
Numeric::Uint(i) =>
NotNan::new(*i as f64).expect("ints cannot cast to NaN"),
}
}
/// Wrap a f64 in a Numeric
fn num(value: f64) -> Result<Self, Rc<dyn ExternError>> {
pub fn new(value: f64) -> Result<Self, Rc<dyn ExternError>> {
if value.is_finite() {
NotNan::new(value)
.map(Self::Num)
.map(Self::Float)
.map_err(|_| ArithmeticError::NaN.into_extern())
} else {
Err(ArithmeticError::Infinity.into_extern())
@@ -43,20 +51,17 @@ impl Numeric {
}
impl TryFromExprInst for Numeric {
fn from_exi(exi: ExprInst) -> Result<Self, Rc<dyn ExternError>> {
match get_literal(exi)? {
(Literal::Uint(i), _) => Ok(Numeric::Uint(i)),
(Literal::Num(n), _) => Ok(Numeric::Num(n)),
(_, location) => AssertionError::fail(location, "an integer or number")?,
}
(exi.request())
.ok_or_else(|| AssertionError::ext(Location::Unknown, "a numeric value"))
}
}
impl ToClause for Numeric {
fn to_clause(self) -> Clause {
Clause::P(Primitive::Literal(match self {
Numeric::Uint(i) => Literal::Uint(i),
Numeric::Num(n) => Literal::Num(n),
}))
match self {
Numeric::Uint(i) => i.atom_cls(),
Numeric::Float(n) => n.atom_cls(),
}
}
}
@@ -70,19 +75,19 @@ pub fn add(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
.checked_add(b)
.map(Numeric::Uint)
.ok_or_else(|| ArithmeticError::Overflow.into_extern()),
(Numeric::Num(a), Numeric::Num(b)) => Numeric::num(*(a + b)),
(Numeric::Num(a), Numeric::Uint(b))
| (Numeric::Uint(b), Numeric::Num(a)) => Numeric::num(*a + b as f64),
(Numeric::Float(a), Numeric::Float(b)) => Numeric::new(*(a + b)),
(Numeric::Float(a), Numeric::Uint(b))
| (Numeric::Uint(b), Numeric::Float(a)) => Numeric::new(*a + b as f64),
}
}
/// Subtract a number from another. Always returns Number.
pub fn subtract(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
match (a, b) {
(Numeric::Uint(a), Numeric::Uint(b)) => Numeric::num(a as f64 - b as f64),
(Numeric::Num(a), Numeric::Num(b)) => Numeric::num(*(a - b)),
(Numeric::Num(a), Numeric::Uint(b)) => Numeric::num(*a - b as f64),
(Numeric::Uint(a), Numeric::Num(b)) => Numeric::num(a as f64 - *b),
(Numeric::Uint(a), Numeric::Uint(b)) => Numeric::new(a as f64 - b as f64),
(Numeric::Float(a), Numeric::Float(b)) => Numeric::new(*(a - b)),
(Numeric::Float(a), Numeric::Uint(b)) => Numeric::new(*a - b as f64),
(Numeric::Uint(a), Numeric::Float(b)) => Numeric::new(a as f64 - *b),
}
}
@@ -94,9 +99,9 @@ pub fn multiply(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
.checked_mul(b)
.map(Numeric::Uint)
.ok_or_else(|| ArithmeticError::Overflow.into_extern()),
(Numeric::Num(a), Numeric::Num(b)) => Numeric::num(*(a * b)),
(Numeric::Uint(a), Numeric::Num(b))
| (Numeric::Num(b), Numeric::Uint(a)) => Numeric::num(a as f64 * *b),
(Numeric::Float(a), Numeric::Float(b)) => Numeric::new(*(a * b)),
(Numeric::Uint(a), Numeric::Float(b))
| (Numeric::Float(b), Numeric::Uint(a)) => Numeric::new(a as f64 * *b),
}
}
@@ -107,7 +112,7 @@ pub fn divide(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
if b == 0.0 {
return Err(ArithmeticError::DivByZero.into_extern());
}
Numeric::num(a / b)
Numeric::new(a / b)
}
/// Take the remainder of two numbers. If they're both uint, the output is
@@ -118,23 +123,31 @@ pub fn remainder(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
.checked_rem(b)
.map(Numeric::Uint)
.ok_or_else(|| ArithmeticError::DivByZero.into_extern()),
(Numeric::Num(a), Numeric::Num(b)) => Numeric::num(*(a % b)),
(Numeric::Uint(a), Numeric::Num(b)) => Numeric::num(a as f64 % *b),
(Numeric::Num(a), Numeric::Uint(b)) => Numeric::num(*a % b as f64),
(Numeric::Float(a), Numeric::Float(b)) => Numeric::new(*(a % b)),
(Numeric::Uint(a), Numeric::Float(b)) => Numeric::new(a as f64 % *b),
(Numeric::Float(a), Numeric::Uint(b)) => Numeric::new(*a % b as f64),
}
}
pub fn less_than(a: Numeric, b: Numeric) -> XfnResult<bool> {
Ok(match (a, b) {
(Numeric::Uint(a), Numeric::Uint(b)) => a < b,
(a, b) => a.as_f64() < b.as_f64(),
})
}
// endregion
pub fn num(i: &Interner) -> ConstTree {
ConstTree::tree([(
i.i("num"),
i.i("number"),
ConstTree::tree([
(i.i("add"), ConstTree::xfn(xfn_2ary(add))),
(i.i("subtract"), ConstTree::xfn(xfn_2ary(subtract))),
(i.i("multiply"), ConstTree::xfn(xfn_2ary(multiply))),
(i.i("divide"), ConstTree::xfn(xfn_2ary(divide))),
(i.i("remainder"), ConstTree::xfn(xfn_2ary(remainder))),
(i.i("less_than"), ConstTree::xfn(xfn_2ary(less_than))),
]),
)])
}

8
src/systems/stl/option.orc
View File

@@ -1,9 +1,9 @@
import std::panic
export const some := \v. \d.\f. f v
export const none := \d.\f. d
export const some := \v. \d. \f. f v
export const none := \d. \f. d
export const map := \option.\f. option none f
export const map := \option. \f. option none f
export const flatten := \option. option none \opt. opt
export const flatmap := \option.\f. option none \opt. map opt f
export const flatmap := \option. \f. option none \opt. map opt f
export const unwrap := \option. option (panic "value expected") \x.x

14
src/systems/stl/prelude.orc
View File

@@ -1,11 +1,13 @@
import std::num::*
export ::[+ - * / %]
import std::str::*
import std::number::*
export ::[+ - * / % < > <= >=]
import std::string::*
export ::[++]
import std::bool::*
export ::([==], if, then, else, true, false)
import std::fn::*
export ::([== !=], if, then, else, true, false, and, or, not)
import std::functional::*
export ::([$ |> =>], identity, pass, pass2, return)
import std::procedural::*
export ::(do, let, cps, [; =])
import std::tuple::*
export ::(t)
import std::tuple
@@ -14,7 +16,7 @@ import std::map
import std::option
export ::(tuple, list, map, option)
import std::loop::*
export ::(loop_over, recursive)
export ::(loop_over, recursive, while)
import std::known::*
export ::[,]

9
src/systems/stl/proc.orc → src/systems/stl/procedural.orc
View File

@@ -1,6 +1,4 @@
import super::fn::=>
export operators[ ; = ]
import super::functional::=>
-- remove duplicate ;-s
export macro do {
@@ -8,12 +6,13 @@ export macro do {
} =0x3p130=> do {
...$statement ; ...$rest
}
-- modular operation block that returns a value
export macro do {
...$statement ; ...$rest:1
} =0x2p130=> statement (...$statement) (do { ...$rest })
export macro do { ...$return } =0x1p130=> (...$return)
export ::do
-- modular operation block that returns a CPS function
export macro do cps { ...$body } =0x1p130=> \cont. do { ...$body ; cont }
export macro statement (let $name = ...$value) (...$next) =0x1p230=> (
( \$name. ...$next) (...$value)

10
src/systems/stl/result.orc
View File

@@ -1,10 +1,10 @@
import std::panic
export const ok := \v. \fe.\fv. fv v
export const err := \e. \fe.\fv. fe e
export const ok := \v. \fe. \fv. fv v
export const err := \e. \fe. \fv. fe e
export const map := \result.\fv. result err fv
export const map_err := \result.\fe. result fe ok
export const map := \result. \fv. result err fv
export const map_err := \result. \fe. result fe ok
export const flatten := \result. result err \res. res
export const and_then := \result.\f. result err \v. f v
export const and_then := \result. \f. result err \v. f v
export const unwrap := \result. result (\e. panic "value expected") \v.v

17
src/systems/stl/state.rs
View File

@@ -1,6 +1,5 @@
use std::cell::RefCell;
use std::ops::Deref;
use std::rc::Rc;
use std::sync::{Arc, RwLock};
use crate::foreign::cps_box::{const_cps, init_cps, CPSBox};
use crate::foreign::{xfn_1ary, Atomic, InertAtomic, XfnResult};
@@ -10,9 +9,9 @@ use crate::systems::codegen::call;
use crate::{ConstTree, Interner};
#[derive(Debug, Clone)]
pub struct State(Rc<RefCell<ExprInst>>);
pub struct State(Arc<RwLock<ExprInst>>);
impl InertAtomic for State {
fn type_str() -> &'static str { "a stateful container" }
fn type_str() -> &'static str { "State" }
}
#[derive(Debug, Clone)]
@@ -30,21 +29,21 @@ fn set_state(s: State) -> XfnResult<Clause> { Ok(init_cps(2, SetStateCmd(s))) }
fn new_state_handler<E>(cmd: CPSBox<NewStateCmd>) -> Result<ExprInst, E> {
let (_, default, handler) = cmd.unpack2();
let state = State(Rc::new(RefCell::new(default)));
let state = State(Arc::new(RwLock::new(default)));
Ok(call(handler, [state.atom_exi()]).wrap())
}
fn set_state_handler<E>(cmd: CPSBox<SetStateCmd>) -> Result<ExprInst, E> {
let (SetStateCmd(state), value, handler) = cmd.unpack2();
*state.0.as_ref().borrow_mut() = value;
*state.0.as_ref().write().unwrap() = value;
Ok(handler)
}
fn get_state_handler<E>(cmd: CPSBox<GetStateCmd>) -> Result<ExprInst, E> {
let (GetStateCmd(state), handler) = cmd.unpack1();
let val = match Rc::try_unwrap(state.0) {
Ok(cell) => cell.into_inner(),
Err(rc) => rc.as_ref().borrow().deref().clone(),
let val = match Arc::try_unwrap(state.0) {
Ok(lock) => lock.into_inner().unwrap(),
Err(arc) => arc.as_ref().read().unwrap().deref().clone(),
};
Ok(call(handler, [val]).wrap())
}

22
src/systems/stl/stl_system.rs
View File

@@ -1,15 +1,17 @@
#![allow(non_upper_case_globals)]
use hashbrown::HashMap;
use rust_embed::RustEmbed;
use super::bin::bin;
use super::binary::bin;
use super::bool::bool;
use super::conv::conv;
use super::exit_status::exit_status;
use super::inspect::inspect;
use super::num::num;
use super::number::num;
use super::panic::panic;
use super::state::{state_handlers, state_lib};
use super::str::str;
use super::string::str;
use crate::facade::{IntoSystem, System};
use crate::interner::Interner;
use crate::pipeline::file_loader::embed_to_map;
@@ -32,10 +34,16 @@ struct StlEmbed;
impl IntoSystem<'static> for StlConfig {
fn into_system(self, i: &Interner) -> System<'static> {
let pure_fns =
conv(i) + bool(i) + str(i) + num(i) + bin(i) + panic(i) + state_lib(i);
let pure_tree = bin(i)
+ bool(i)
+ conv(i)
+ exit_status(i)
+ num(i)
+ panic(i)
+ state_lib(i)
+ str(i);
let mk_impure_fns = || inspect(i);
let fns = if self.impure { pure_fns + mk_impure_fns() } else { pure_fns };
let fns = if self.impure { pure_tree + mk_impure_fns() } else { pure_tree };
System {
name: vec!["std".to_string()],
constants: HashMap::from([(i.i("std"), fns)]),
@@ -49,6 +57,8 @@ impl IntoSystem<'static> for StlConfig {
}]),
}],
handlers: state_handlers(),
lexer_plugin: None,
line_parser: None,
}
}
}

6
src/systems/stl/str.orc → src/systems/stl/string.orc
View File

@@ -1,10 +1,8 @@
import super::(proc::*, bool::*, panic)
export operators[++]
import super::(procedural::*, bool::*, panic)
export macro ...$a ++ ...$b =0x4p36=> (concat (...$a) (...$b))
export const char_at := \s.\i. do{
export const char_at := \s. \i. do{
let slc = slice s i 1;
if len slc == 1
then slc

32
src/systems/stl/str.rs → src/systems/stl/string.rs
View File

@@ -1,31 +1,31 @@
use unicode_segmentation::UnicodeSegmentation;
use crate::foreign::{xfn_1ary, xfn_2ary, xfn_3ary, XfnResult};
use crate::error::RuntimeError;
use crate::foreign::{
xfn_1ary, xfn_2ary, xfn_3ary, Atomic, ToClause, XfnResult,
};
use crate::interner::Interner;
use crate::interpreted::Clause;
use crate::representations::OrcString;
use crate::systems::codegen::{opt, tuple};
use crate::systems::RuntimeError;
use crate::utils::iter_find;
use crate::{ConstTree, Literal};
use crate::ConstTree;
pub fn len(s: OrcString) -> XfnResult<u64> {
Ok(s.graphemes(true).count() as u64)
}
pub fn len(s: OrcString) -> XfnResult<usize> { Ok(s.graphemes(true).count()) }
pub fn size(s: OrcString) -> XfnResult<u64> { Ok(s.as_bytes().len() as u64) }
pub fn size(s: OrcString) -> XfnResult<usize> { Ok(s.as_bytes().len()) }
/// Append a string to another
pub fn concatenate(a: OrcString, b: OrcString) -> XfnResult<String> {
Ok(a.get_string() + b.as_str())
}
pub fn slice(s: OrcString, i: u64, len: u64) -> XfnResult<String> {
pub fn slice(s: OrcString, i: usize, len: usize) -> XfnResult<String> {
let graphs = s.as_str().graphemes(true);
if i == 0 {
return Ok(graphs.take(len as usize).collect::<String>());
return Ok(graphs.take(len).collect::<String>());
}
let mut prefix = graphs.skip(i as usize - 1);
let mut prefix = graphs.skip(i - 1);
if prefix.next().is_none() {
return Err(RuntimeError::ext(
"Character index out of bounds".to_string(),
@@ -33,7 +33,7 @@ pub fn slice(s: OrcString, i: u64, len: u64) -> XfnResult<String> {
));
}
let mut count = 0;
let ret = (prefix.take(len as usize))
let ret = (prefix.take(len))
.map(|x| {
count += 1;
x
@@ -52,19 +52,19 @@ pub fn slice(s: OrcString, i: u64, len: u64) -> XfnResult<String> {
pub fn find(haystack: OrcString, needle: OrcString) -> XfnResult<Clause> {
let haystack_graphs = haystack.as_str().graphemes(true);
let found = iter_find(haystack_graphs, needle.as_str().graphemes(true));
Ok(opt(found.map(|x| Literal::Uint(x as u64).into())))
Ok(opt(found.map(|x| x.atom_exi())))
}
pub fn split(s: OrcString, i: u64) -> XfnResult<Clause> {
pub fn split(s: OrcString, i: usize) -> XfnResult<Clause> {
let mut graphs = s.as_str().graphemes(true);
let a = graphs.by_ref().take(i as usize).collect::<String>();
let a = graphs.by_ref().take(i).collect::<String>();
let b = graphs.collect::<String>();
Ok(tuple([a.into(), b.into()]))
Ok(tuple([a.to_exi(), b.to_exi()]))
}
pub fn str(i: &Interner) -> ConstTree {
ConstTree::tree([(
i.i("str"),
i.i("string"),
ConstTree::tree([
(i.i("concat"), ConstTree::xfn(xfn_2ary(concatenate))),
(i.i("slice"), ConstTree::xfn(xfn_3ary(slice))),

6
src/systems/stl/tuple.orc
View File

@@ -1,11 +1,11 @@
import super::(known::*, bool::*, num::*)
import super::(known::*, bool::*, number::*)
const discard_args := \n.\value. (
const discard_args := \n. \value. (
if n == 0 then value
else \_. discard_args (n - 1) value
)
export const pick := \tuple. \i.\n. tuple (
export const pick := \tuple. \i. \n. tuple (
discard_args i \val. discard_args (n - 1 - i) val
)