retoor/orchid
1
0
Fork 0
forked from Orchid/orchid
Code Pull Requests 1 Activity

Removed foreign macros

Browse Source 
Converted the function integration to use template
metaprogramming instead of macros.
This commit is contained in:
Lawrence Bethlenfalvy
2023-09-22 23:17:54 +01:00
parent 7396078304
commit ba0b155ebd
45 changed files with 854 additions and 1126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
examples/file-browser/main.orc
View File

@@ -1,31 +1,38 @@
import system::(io, directfs, async)
import std::proc::*
import std::(to_string, to_uint)
import std::(to_string, to_uint, inspect)
const folder_view := \path.\next. do{
cps println $ "Contents of " ++ path;
cps entries = async::block_on $ directfs::readdir path;
cps println $ "Contents of " ++ directfs::os_print path;
cps entries = async::block_on $ directfs::read_dir path;
cps list::enumerate entries
|> list::map (pass \id. pass \name.\is_dir. (
println $ to_string id ++ ": " ++ name ++ if is_dir then "/" else ""
))
|> list::map (pass \id. pass \name.\is_dir.
println $ to_string id ++ ": " ++ directfs::os_print name ++ if is_dir then "/" else ""
)
|> list::chain;
cps print "select an entry, or .. to move up: ";
cps choice = readln;
let output = if choice == "..\n"
then directfs::pop_path path
if (choice == "..\n") then do {
let parent_path = directfs::pop_path path
|> option::unwrap
|> tuple::pick 0 2
else (
to_uint choice
|> (list::get entries)
|> option::unwrap
|> (directfs::join_paths path)
);
next output
|> tuple::pick 0 2;
next parent_path
} else do {
cps subname, is_dir = to_uint choice
|> (list::get entries)
|> option::unwrap;
let subpath = directfs::join_paths path subname;
if is_dir then next subpath
else do {
cps file = async::block_on $ directfs::read_file subpath;
cps contents = async::block_on $ io::read_string file;
cps println contents;
next path
}
}
}
const main := loop_over (path = "/home/lbfalvy/Code/orchid/examples") {
const main := loop_over (path = directfs::cwd) {
cps path = folder_view path;
}

1
src/bin/orcx.rs
View File

@@ -157,6 +157,7 @@ pub fn main() {
return macro_debug(premacro, sym);
}
let mut proc = premacro.build_process(Some(args.macro_limit)).unwrap();
proc.validate_refs().unwrap();
let main = interpreted::Clause::Constant(i.i(&main)).wrap();
let ret = proc.run(main, None).unwrap();
let interpreter::Return { gas, state, inert } = ret;

2
src/error/mod.rs
View File

@@ -1,8 +1,8 @@
//! Various errors the pipeline can produce
mod conflicting_roles;
mod import_all;
mod no_targets;
mod not_exported;
mod conflicting_roles;
mod parse_error_with_tokens;
mod project_error;
mod too_many_supers;

47
src/facade/process.rs
View File

@@ -1,6 +1,7 @@
use hashbrown::HashMap;
use itertools::Itertools;
use crate::error::{ProjectError, ProjectResult};
use crate::error::{ErrorPosition, ProjectError, ProjectResult};
use crate::interpreted::{self, ExprInst};
#[allow(unused)] // for doc
use crate::interpreter;
@@ -53,24 +54,34 @@ impl<'a> Process<'a> {
/// unless [interpreted::Clause::Constant]s are created procedurally,
/// a [interpreter::RuntimeError::MissingSymbol] cannot be produced
pub fn validate_refs(&self) -> ProjectResult<()> {
let mut errors = Vec::new();
for key in self.symbols.keys() {
if let Some((symbol, location)) = self.unbound_refs(key.clone()).pop() {
return Err(
MissingSymbol { location, referrer: key.clone(), symbol }.rc(),
);
}
errors.extend(self.unbound_refs(key.clone()).into_iter().map(
|(symbol, location)| MissingSymbol {
symbol,
location,
referrer: key.clone(),
},
));
}
match errors.is_empty() {
true => Ok(()),
false => Err(MissingSymbols { errors }.rc()),
}
Ok(())
}
}
#[derive(Debug)]
#[derive(Debug, Clone)]
pub struct MissingSymbol {
referrer: Sym,
location: Location,
symbol: Sym,
}
impl ProjectError for MissingSymbol {
#[derive(Debug)]
pub struct MissingSymbols {
errors: Vec<MissingSymbol>,
}
impl ProjectError for MissingSymbols {
fn description(&self) -> &str {
"A name not referring to a known symbol was found in the source after \
macro execution. This can either mean that a symbol name was mistyped, or \
@@ -79,11 +90,21 @@ impl ProjectError for MissingSymbol {
fn message(&self) -> String {
format!(
"The symbol {} referenced in {} does not exist",
self.symbol.extern_vec().join("::"),
self.referrer.extern_vec().join("::")
"The following symbols do not exist:\n{}",
(self.errors.iter())
.map(|e| format!(
"{} referenced in {} ",
e.symbol.extern_vec().join("::"),
e.referrer.extern_vec().join("::")
))
.join("\n")
)
}
fn one_position(&self) -> Location { self.location.clone() }
fn positions(&self) -> crate::utils::BoxedIter<crate::error::ErrorPosition> {
Box::new(
(self.errors.clone().into_iter())
.map(|i| ErrorPosition { location: i.location, message: None }),
)
}
}

2
src/foreign/cps_box.rs
View File

@@ -36,7 +36,7 @@ impl<T: CPSPayload> CPSFn<T> {
}
impl<T: CPSPayload> ExternFn for CPSFn<T> {
fn name(&self) -> &str { "CPS function without argument" }
fn apply(self: Box<Self>, arg: ExprInst, _ctx: Context) -> XfnResult {
fn apply(self: Box<Self>, arg: ExprInst, _ctx: Context) -> XfnResult<Clause> {
let payload = self.payload.clone();
let continuations = pushed_ref(&self.continuations, arg);
if self.argc == 1 {

6
src/foreign/extern_fn.rs
View File

@@ -5,14 +5,12 @@ use std::rc::Rc;
use dyn_clone::DynClone;
use super::XfnResult;
use crate::interpreted::ExprInst;
use crate::interpreter::Context;
use crate::representations::interpreted::Clause;
use crate::Primitive;
/// Returned by [ExternFn::apply]
pub type XfnResult = Result<Clause, Rc<dyn ExternError>>;
/// Errors produced by external code
pub trait ExternError: Display {
/// Convert into trait object
@@ -41,7 +39,7 @@ pub trait ExternFn: DynClone {
#[must_use]
fn name(&self) -> &str;
/// Combine the function with an argument to produce a new clause
fn apply(self: Box<Self>, arg: ExprInst, ctx: Context) -> XfnResult;
fn apply(self: Box<Self>, arg: ExprInst, ctx: Context) -> XfnResult<Clause>;
/// Hash the name to get a somewhat unique hash.
fn hash(&self, mut state: &mut dyn std::hash::Hasher) {
self.name().hash(&mut state)

199
src/foreign/fn_bridge.rs Normal file
View File

@@ -0,0 +1,199 @@
use std::fmt::Debug;
use std::marker::PhantomData;
use std::rc::Rc;
use super::{
Atomic, AtomicResult, AtomicReturn, ExternError, ExternFn, XfnResult,
};
use crate::ddispatch::Responder;
use crate::interpreted::{Clause, ExprInst, TryFromExprInst};
use crate::interpreter::{run, Context, Return};
use crate::systems::codegen::{opt, res};
use crate::{Literal, OrcString};
/// A trait for things that are infallibly convertible to [Clause]. These types
/// can be returned by callbacks passed to the [super::xfn_1ary] family of
/// functions.
pub trait ToClause: Clone {
/// Convert the type to a [Clause].
fn to_clause(self) -> Clause;
}
impl<T: Atomic + Clone> ToClause for T {
fn to_clause(self) -> Clause { self.atom_cls() }
}
impl ToClause for Clause {
fn to_clause(self) -> Clause { self }
}
impl ToClause for ExprInst {
fn to_clause(self) -> Clause { self.expr_val().clause }
}
impl ToClause for Literal {
fn to_clause(self) -> Clause { self.into() }
}
impl ToClause for u64 {
fn to_clause(self) -> Clause { Literal::Uint(self).into() }
}
impl ToClause for String {
fn to_clause(self) -> Clause { OrcString::from(self).cls() }
}
impl<T: ToClause> ToClause for Option<T> {
fn to_clause(self) -> Clause { opt(self.map(|t| t.to_clause().wrap())) }
}
impl<T: ToClause, U: ToClause> ToClause for Result<T, U> {
fn to_clause(self) -> Clause {
res(self.map(|t| t.to_clause().wrap()).map_err(|u| u.to_clause().wrap()))
}
}
/// Return a unary lambda wrapped in this struct to take an additional argument
/// in a function passed to Orchid through a member of the [super::xfn_1ary]
/// family.
///
/// Container for a unary [FnOnce] that uniquely states the argument and return
/// type. Rust functions are never overloaded, but inexplicably the [Fn] traits
/// take the argument tuple as a generic parameter which means that it cannot
/// be a unique dispatch target.
pub struct Param<T, U, F> {
data: F,
_t: PhantomData<T>,
_u: PhantomData<U>,
}
impl<T, U, F> Param<T, U, F> {
/// Wrap a new function in a parametric struct
pub fn new(f: F) -> Self
where
F: FnOnce(T) -> Result<U, Rc<dyn ExternError>>,
{
Self { data: f, _t: PhantomData::default(), _u: PhantomData::default() }
}
/// Take out the function
pub fn get(self) -> F { self.data }
}
impl<T, U, F: Clone> Clone for Param<T, U, F> {
fn clone(&self) -> Self {
Self {
data: self.data.clone(),
_t: PhantomData::default(),
_u: PhantomData::default(),
}
}
}
impl<
T: 'static + TryFromExprInst,
U: 'static + ToClause,
F: 'static + Clone + FnOnce(T) -> Result<U, Rc<dyn ExternError>>,
> ToClause for Param<T, U, F>
{
fn to_clause(self) -> Clause { self.xfn_cls() }
}
struct FnMiddleStage<T, U, F> {
argument: ExprInst,
f: Param<T, U, F>,
}
impl<T, U, F: Clone> Clone for FnMiddleStage<T, U, F> {
fn clone(&self) -> Self {
Self { argument: self.argument.clone(), f: self.f.clone() }
}
}
impl<T, U, F> Debug for FnMiddleStage<T, U, F> {
fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
f.debug_struct("FnMiddleStage")
.field("argument", &self.argument)
.finish_non_exhaustive()
}
}
impl<T, U, F> Responder for FnMiddleStage<T, U, F> {}
impl<
T: 'static + TryFromExprInst,
U: 'static + ToClause,
F: 'static + Clone + FnOnce(T) -> Result<U, Rc<dyn ExternError>>,
> Atomic for FnMiddleStage<T, U, F>
{
fn as_any(self: Box<Self>) -> Box<dyn std::any::Any> { self }
fn as_any_ref(&self) -> &dyn std::any::Any { self }
fn run(self: Box<Self>, ctx: Context) -> AtomicResult {
let Return { gas, inert, state } = run(self.argument, ctx)?;
let clause = match inert {
false => state.expr_val().clause,
true => (self.f.data)(state.downcast()?)?.to_clause(),
};
Ok(AtomicReturn { gas, inert: false, clause })
}
}
impl<
T: 'static + TryFromExprInst,
U: 'static + ToClause,
F: 'static + Clone + FnOnce(T) -> Result<U, Rc<dyn ExternError>>,
> ExternFn for Param<T, U, F>
{
fn name(&self) -> &str { "anonymous Rust function" }
fn apply(self: Box<Self>, arg: ExprInst, _: Context) -> XfnResult<Clause> {
Ok(FnMiddleStage { argument: arg, f: *self }.atom_cls())
}
}
pub mod constructors {
use std::rc::Rc;
use super::{Param, ToClause};
use crate::foreign::{ExternError, ExternFn};
use crate::interpreted::TryFromExprInst;
macro_rules! xfn_variant {
(
$number:expr,
($($t:ident)*)
($($alt:expr)*)
) => {
paste::paste!{
#[doc = "Convert a function of " $number " argument(s) into a curried"
" Orchid function. See also Constraints summarized:\n\n"
"- the callback must live as long as `'static`\n"
"- All arguments must implement [TryFromExprInst]\n"
"- all but the last argument must implement [Clone]\n"
"- the return type must implement [ToClause].\n\n"
]
#[doc = "Other arities: " $( "[xfn_" $alt "ary], " )+ ]
pub fn [< xfn_ $number ary >] <
$( $t : TryFromExprInst + Clone + 'static, )*
TLast: TryFromExprInst + 'static,
TReturn: ToClause + 'static,
TFunction: FnOnce( $( $t , )* TLast )
-> Result<TReturn, Rc<dyn ExternError>> + Clone + 'static
>(function: TFunction) -> impl ExternFn {
xfn_variant!(@BODY_LOOP function
( $( ( $t [< $t:lower >] ) )* )
( $( [< $t:lower >] )* )
)
}
}
};
(@BODY_LOOP $function:ident (
( $Next:ident $next:ident )
$( ( $T:ident $t:ident ) )*
) $full:tt) => {
Param::new(|$next : $Next| {
Ok(xfn_variant!(@BODY_LOOP $function ( $( ( $T $t ) )* ) $full))
})
};
(@BODY_LOOP $function:ident () ( $( $t:ident )* )) => {
Param::new(|last: TLast| $function ( $( $t , )* last ))
};
}
xfn_variant!(1, () (2 3 4 5 6 7 8 9 10 11 12 13 14 15 16));
xfn_variant!(2, (A) (1 3 4 5 6 7 8 9 10 11 12 13 14 15 16));
xfn_variant!(3, (A B) (1 2 4 5 6 7 8 9 10 11 12 13 14 15 16));
xfn_variant!(4, (A B C) (1 2 3 5 6 7 8 9 10 11 12 13 14 15 16));
xfn_variant!(5, (A B C D) (1 2 3 4 6 7 8 9 10 11 12 13 14 15 16));
xfn_variant!(6, (A B C D E) (1 2 3 4 5 7 8 9 10 11 12 13 14 15 16));
xfn_variant!(7, (A B C D E F) (1 2 3 4 5 6 8 9 10 11 12 13 14 15 16));
xfn_variant!(8, (A B C D E F G) (1 2 3 4 5 6 7 9 10 11 12 13 14 15 16));
xfn_variant!(9, (A B C D E F G H) (1 2 3 4 5 6 7 8 10 11 12 13 14 15 16));
// at higher arities rust-analyzer fails to load the project
}

2
src/foreign/inert.rs
View File

@@ -4,7 +4,7 @@ use std::rc::Rc;
use super::{AtomicResult, AtomicReturn, ExternError};
#[allow(unused)] // for doc
use crate::define_fn;
// use crate::define_fn;
use crate::foreign::Atomic;
use crate::interpreted::{Clause, Expr, ExprInst, TryFromExprInst};
use crate::interpreter::Context;

12
src/foreign/mod.rs
View File

@@ -5,15 +5,21 @@
mod atom;
pub mod cps_box;
mod extern_fn;
mod fn_bridge;
mod inert;
use std::rc::Rc;
pub use atom::{Atom, Atomic, AtomicResult, AtomicReturn};
pub use extern_fn::{ExternError, ExternFn, XfnResult};
pub use extern_fn::{ExternError, ExternFn};
pub use fn_bridge::constructors::{
xfn_1ary, xfn_2ary, xfn_3ary, xfn_4ary, xfn_5ary, xfn_6ary, xfn_7ary,
xfn_8ary, xfn_9ary,
};
pub use fn_bridge::{Param, ToClause};
pub use inert::InertAtomic;
pub use crate::representations::interpreted::Clause;
/// A type-erased error in external code
pub type RcError = Rc<dyn ExternError>;
/// Return type of the argument to the [xfn_1ary] family of functions
pub type XfnResult<T> = Result<T, Rc<dyn ExternError>>;

121
src/foreign_macros/atomic_impl.rs
View File

@@ -1,121 +0,0 @@
#[allow(unused)] // for the doc comments
use std::any::Any;
#[allow(unused)] // for the doc comments
use std::fmt::Debug;
#[allow(unused)] // for the doc comments
use dyn_clone::DynClone;
#[allow(unused)] // for the doc comments
use crate::define_fn;
#[allow(unused)] // for the doc comments
use crate::foreign::{Atomic, ExternFn};
#[allow(unused)] // for the doc comments
use crate::write_fn_step;
#[allow(unused)] // for the doc comments
use crate::Primitive;
/// A macro that generates implementations of [Atomic] to simplify the
/// development of external bindings for Orchid.
///
/// Most use cases are fulfilled by [define_fn], pathological cases can combine
/// [write_fn_step] with manual [Atomic] implementations.
///
/// The macro depends on implementations of [`AsRef<Clause>`] and
/// [`From<(&Self, Clause)>`] for extracting the clause to be processed and then
/// reconstructing the [Atomic]. Naturally, supertraits of [Atomic] are also
/// dependencies. These are [Any], [Debug] and [Clone].
///
/// The simplest form just requires the typename to be specified. This
/// additionally depends on an implementation of [ExternFn] because after the
/// clause is fully normalized it returns `Self` wrapped in a
/// [Primitive::ExternFn]. It is intended for intermediary stages of the
/// function where validation and the next state are defined in
/// [ExternFn::apply].
///
/// The last stage of the function should use the extended form of the macro
/// which takes an additional closure to explicitly describe what happens when
/// the argument is fully processed.
///
/// _definition of the `add` function in the STL_
/// ```
/// use orchidlang::{Literal};
/// use orchidlang::interpreted::{ExprInst, Clause};
/// use orchidlang::systems::cast_exprinst::get_literal;
/// use orchidlang::{atomic_impl, atomic_redirect, externfn_impl};
/// use orchidlang::ddispatch::Responder;
///
/// /// Convert a literal to a string using Rust's conversions for floats, chars and
/// /// uints respectively
/// #[derive(Clone)]
/// struct ToString;
///
/// externfn_impl!{
/// ToString, |_: Self, expr_inst: ExprInst|{
/// Ok(InternalToString { expr_inst })
/// }
/// }
/// #[derive(std::fmt::Debug,Clone)]
/// struct InternalToString {
/// expr_inst: ExprInst,
/// }
/// impl Responder for InternalToString {}
/// atomic_redirect!(InternalToString, expr_inst);
/// atomic_impl!(InternalToString, |Self { expr_inst }: Self, _|{
/// Ok(match get_literal(expr_inst)?.0 {
/// Literal::Uint(i) => Clause::from(Literal::Str(i.to_string().into())),
/// Literal::Num(n) => Clause::from(Literal::Str(n.to_string().into())),
/// s@Literal::Str(_) => Clause::from(s),
/// })
/// });
/// ```
#[macro_export]
macro_rules! atomic_impl {
($typ:ident) => {
$crate::atomic_impl! {$typ, |this: Self, _: $crate::interpreter::Context| {
use $crate::foreign::ExternFn;
Ok(this.xfn_cls())
}}
};
($typ:ident, $next_phase:expr) => {
impl $crate::foreign::Atomic for $typ {
fn as_any(self: Box<Self>) -> Box<dyn std::any::Any> { self }
fn as_any_ref(&self) -> &dyn std::any::Any { self }
fn run(
self: Box<Self>,
ctx: $crate::interpreter::Context,
) -> $crate::foreign::AtomicResult {
// extract the expression
let mut this = *self;
let expr =
<Self as AsMut<$crate::interpreted::ExprInst>>::as_mut(&mut this);
// run the expression
let (gas, inert) =
$crate::take_with_output(
expr,
|expr| match $crate::interpreter::run(expr, ctx.clone()) {
Ok(ret) => (ret.state, Ok((ret.gas, ret.inert))),
Err(e) => ($crate::interpreted::Clause::Bottom.wrap(), Err(e)),
},
)?;
// branch off or wrap up
let clause = if inert {
let closure = $next_phase;
let res: Result<
$crate::interpreted::Clause,
std::rc::Rc<dyn $crate::foreign::ExternError>,
> = closure(this, ctx);
match res {
Ok(r) => r,
Err(e) => return Err($crate::interpreter::RuntimeError::Extern(e)),
}
} else {
this.atom_cls()
};
// package and return
Ok($crate::foreign::AtomicReturn { clause, gas, inert: false })
}
}
};
}

20
src/foreign_macros/atomic_redirect.rs
View File

@@ -1,20 +0,0 @@
#[allow(unused)]
use crate::atomic_impl;
/// Implement the traits required by [atomic_impl] to redirect run calls
/// to a field with a particular name.
#[macro_export]
macro_rules! atomic_redirect {
($typ:ident) => {
impl AsMut<$crate::interpreted::ExprInst> for $typ {
fn as_mut(&mut self) -> &mut $crate::interpreted::ExprInst { &mut self.0 }
}
};
($typ:ident, $field:ident) => {
impl AsMut<$crate::interpreted::ExprInst> for $typ {
fn as_mut(&mut self) -> &mut $crate::interpreted::ExprInst {
&mut self.$field
}
}
};
}

203
src/foreign_macros/define_fn.rs
View File

@@ -1,203 +0,0 @@
#[allow(unused)] // for doc
use crate::foreign::ExternFn;
#[allow(unused)] // for doc
use crate::interpreted::{ExprInst, TryFromExprInst};
#[allow(unused)] // for doc
use crate::write_fn_step;
/// Define a simple n-ary nonvariadic Orchid function with static argument
/// types.
///
/// This macro relies on [write_fn_step] to define a struct for each step.
/// Because of how Orchid handles state, the arguments must implement [Clone]
/// and [Debug]. All expressions and arguments are accessible as references.
///
/// First, the alias for the newly introduced [ExprInst] is specified. This step
/// is necessary and a default cannot be provided because any name defined in
/// the macro is invisible to the calling code. In the example, the name `x` is
/// selected.
///
/// Then a name and optional visibility is specified for the entry point. This
/// will be a zero-size marker struct implementing [ExternFn]. It can also have
/// documentation and attributes.
///
/// This is followed by the table of arguments. Each defines a name, value type,
/// and a conversion expression which references the [ExprInst] by the name
/// defined in the first step and returns a [Result] of the success type or
/// `Rc<dyn ExternError>`.
///
/// To avoid typing the same expression a lot, the conversion is optional.
/// If it is omitted, the field is initialized using [TryFromExprInst].
/// The optional syntax starts with `as`.
///
/// If all conversions are omitted, the alias definition (`expr=$ident in`) has
/// no effect and is therefore optional.
///
/// Finally, the body of the function is provided as an expression which can
/// reference all of the arguments by their names, each bound to a ref of the
/// specified type.
///
/// ```
/// use orchidlang::interpreted::Clause;
/// use orchidlang::{define_fn, Literal, OrcString, Primitive};
///
/// define_fn! {expr=x in
/// /// Append a string to another
/// pub Concatenate {
/// a: OrcString as x.downcast(),
/// b: OrcString
/// } => {
/// Ok(Clause::P(Primitive::Literal(Literal::Str(
/// OrcString::from(a.get_string() + &b)
/// ))))
/// }
/// }
/// ```
///
/// A simpler format is also offered for unary functions:
///
/// ```
/// use orchidlang::interpreted::Clause;
/// use orchidlang::systems::cast_exprinst::get_literal;
/// use orchidlang::{define_fn, Literal};
///
/// define_fn! {
/// /// Convert a literal to a string using Rust's conversions for floats,
/// /// chars and uints respectively
/// ToString = |x| Ok(match get_literal(x)?.0 {
/// Literal::Uint(i) => Clause::from(Literal::Str(i.to_string().into())),
/// Literal::Num(n) => Clause::from(Literal::Str(n.to_string().into())),
/// s@Literal::Str(_) => Clause::from(s),
/// })
/// }
/// ```
#[macro_export]
macro_rules! define_fn {
// Unary function entry
(
$( #[ $attr:meta ] )* $qual:vis $name:ident = |$x:ident| $body:expr
$(; $( $next:tt )+ )?
) => {
paste::paste!{
$crate::write_fn_step!(
$( #[ $attr ] )* $qual $name
>
[< Internal $name >]
);
$crate::write_fn_step!(
[< Internal $name >]
{}
out = expr => Ok(expr);
{
let lambda = |$x: $crate::interpreted::ExprInst| $body;
lambda(out)
}
);
}
$( $crate::define_fn!{ $( $next )+ } )?
};
// xname is optional only if every conversion is implicit
(
$( #[ $attr:meta ] )* $qual:vis $name:ident {
$( $arg:ident: $typ:ty ),+ $(,)?
} => $body:expr
$(; $( $next:tt )+ )?
) => {
$crate::define_fn!{expr=expr in
$( #[ $attr ] )* $qual $name {
$( $arg: $typ ),*
} => $body
}
$( $crate::define_fn!{ $( $next )+ } )?
};
// multi-parameter function entry
(expr=$xname:ident in
$( #[ $attr:meta ] )*
$qual:vis $name:ident {
$arg0:ident: $typ0:ty $( as $parse0:expr )?
$(, $arg:ident: $typ:ty $( as $parse:expr )? )* $(,)?
} => $body:expr
$(; $( $next:tt )+ )?
) => {
paste::paste!{
// Generate initial state
$crate::write_fn_step!(
$( #[ $attr ] )* $qual $name
>
[< Internal $name >]
);
// Enter loop to generate intermediate states
$crate::define_fn!(@MIDDLE $xname [< Internal $name >] ($body)
()
(
( $arg0: $typ0 $( as $parse0)? )
$(
( $arg: $typ $( as $parse)? )
)*
)
);
}
$( $crate::define_fn!{ expr = $xname in $( $next )+ } )?
};
// Recursive case
(@MIDDLE $xname:ident $name:ident ($body:expr)
// fields that should be included in this struct
(
$(
( $arg_prev:ident: $typ_prev:ty )
)*
)
// later fields
(
// field that should be processed by this step
( $arg0:ident: $typ0:ty $( as $parse0:expr )? )
// ensure that we have a next stage
$(
( $arg:ident: $typ:ty $( as $parse:expr )? )
)+
)
) => {paste::paste!{
$crate::write_fn_step!(
$name
{
$( $arg_prev : $typ_prev ),*
}
[< $name $arg0:camel >]
where $arg0:$typ0 $( = $xname => $parse0 )? ;
);
$crate::define_fn!(@MIDDLE $xname [< $name $arg0:camel >] ($body)
(
$( ($arg_prev: $typ_prev) )*
($arg0: $typ0)
)
(
$(
( $arg: $typ $( as $parse)? )
)+
)
);
}};
// recursive base case
(@MIDDLE $xname:ident $name:ident ($body:expr)
// all but one field is included in this struct
(
$( ($arg_prev:ident: $typ_prev:ty) )*
)
// the last one is initialized before the body runs
(
($arg0:ident: $typ0:ty $( as $parse0:expr )? )
)
) => {
$crate::write_fn_step!(
$name
{
$( $arg_prev: $typ_prev ),*
}
$arg0:$typ0 $( = $xname => $parse0 )? ;
$body
);
};
}

45
src/foreign_macros/externfn_impl.rs
View File

@@ -1,45 +0,0 @@
#[allow(unused)] // for the doc comments
use std::any::Any;
#[allow(unused)] // for the doc comments
use std::fmt::Debug;
#[allow(unused)] // for the doc comments
use std::hash::Hash;
#[allow(unused)] // for the doc comments
use dyn_clone::DynClone;
#[allow(unused)] // for the doc comments
use crate::foreign::{Atomic, ExternFn};
#[allow(unused)] // for the doc comments
use crate::representations::Primitive;
#[allow(unused)] // for the doc comments
use crate::{atomic_impl, atomic_redirect};
/// Implement [ExternFn] with a closure that produces an [Atomic] from a
/// reference to self and a closure. This can be used in conjunction with
/// [atomic_impl] and [atomic_redirect] to normalize the argument automatically
/// before using it.
///
/// See [atomic_impl] for an example.
#[macro_export]
macro_rules! externfn_impl {
($typ:ident, $next_atomic:expr) => {
impl $crate::foreign::ExternFn for $typ {
fn name(&self) -> &str { stringify!($typ) }
fn apply(
self: Box<Self>,
arg: $crate::interpreted::ExprInst,
_ctx: $crate::interpreter::Context,
) -> $crate::foreign::XfnResult {
let closure = $next_atomic;
match closure(*self, arg) {
// ? casts the result but we want to strictly forward it
Ok(r) => Ok($crate::interpreted::Clause::P($crate::Primitive::Atom(
$crate::foreign::Atom::new(r),
))),
Err(e) => Err(e),
}
}
}
};
}

5
src/foreign_macros/mod.rs
View File

@@ -1,5 +0,0 @@
mod atomic_impl;
mod atomic_redirect;
mod define_fn;
mod externfn_impl;
mod write_fn_step;

162
src/foreign_macros/write_fn_step.rs
View File

@@ -1,162 +0,0 @@
#[allow(unused)] // for doc
use crate::define_fn;
#[allow(unused)] // for doc
use crate::foreign::Atomic;
#[allow(unused)] // for doc
use crate::foreign::ExternFn;
#[allow(unused)] // for doc
use crate::interpreted::ExprInst;
/// Write one step in the state machine representing a simple n-ary non-variadic
/// Orchid function. Most use cases are better covered by [define_fn] which
/// generates calls to this macro. This macro can be used in combination with
/// manual [Atomic] implementations to define a function that only behaves like
/// a simple n-ary non-variadic function with respect to some of its arguments.
///
/// There are three ways to call this macro for the initial state, internal
/// state, and exit state. All of them are demonstrated in one example and
/// discussed below. The newly bound names (here `s` and `i` before `=`) can
/// also receive type annotations.
///
/// ```
/// use unicode_segmentation::UnicodeSegmentation;
///
/// use orchidlang::{write_fn_step, Literal, Primitive, OrcString};
/// use orchidlang::interpreted::Clause;
/// use orchidlang::systems::RuntimeError;
///
/// // Initial state
/// write_fn_step!(pub CharAt2 > CharAt1);
/// // Middle state
/// write_fn_step!(
/// CharAt1 {}
/// CharAt0 where s: OrcString = x => x.downcast::<OrcString>();
/// );
/// // Exit state
/// write_fn_step!(
/// CharAt0 { s: OrcString }
/// i = x => x.downcast::<u64>();
/// {
/// if let Some(c) = s.graphemes(true).nth(i as usize) {
/// Ok(Literal::Str(OrcString::from(c.to_string())).into())
/// } else {
/// RuntimeError::fail(
/// "Character index out of bounds".to_string(),
/// "indexing string",
/// )
/// }
/// }
/// );
/// ```
///
/// The initial state simply defines an empty marker struct and implements
/// [ExternFn] on it, transitioning into a new struct which is assumed to have a
/// single field called `expr_inst` of type [ExprInst].
///
/// The middle state defines a sequence of arguments with types similarly to a
/// struct definition. A field called `expr_inst` of type [ExprInst] is added
/// implicitly, so the first middle state has an empty field list. The next
/// state is also provided, alongside the name and conversion of the next
/// parameter from a `&ExprInst` under the provided alias to a
/// `Result<_, Rc<dyn ExternError>>`. The success type is inferred from the
/// type of the field at the place of its actual definition. This conversion is
/// done in the implementation of [ExternFn] which also places the new
/// [ExprInst] into `expr_inst` on the next state.
///
/// The final state defines the sequence of all arguments except for the last
/// one with the same syntax used by the middle state, and the name and
/// conversion lambda of the final argument without specifying the type - it is
/// to be inferred. This state also specifies the operation that gets executed
/// when all the arguments are collected. Uniquely, this "function body" isn't
/// specified as a lambda but rather as an expression invoked with all the
/// argument names bound. The arguments here are all references to their actual
/// types except for the last one which is converted from [ExprInst] immediately
/// before the body is evaluated.
///
/// To avoid typing the same parsing process a lot, the conversion is optional.
/// If it is omitted, the field is initialized with a [TryInto::try_into] call
/// from `&ExprInst` to the target type. In this case, the error is
/// short-circuited using `?` so conversions through `FromResidual` are allowed.
/// The optional syntax starts with the `=` sign and ends before the semicolon.
#[macro_export]
macro_rules! write_fn_step {
// write entry stage
( $( #[ $attr:meta ] )* $quant:vis $name:ident > $next:ident) => {
$( #[ $attr ] )*
#[derive(Clone)]
$quant struct $name;
$crate::externfn_impl!{
$name,
|_: Self, expr_inst: $crate::interpreted::ExprInst| {
Ok($next{ expr_inst })
}
}
};
// write middle stage
(
$( #[ $attr:meta ] )* $quant:vis $name:ident {
$( $arg:ident : $typ:ty ),*
}
$next:ident where
$added:ident $( : $added_typ:ty )? $( = $xname:ident => $extract:expr )? ;
) => {
$( #[ $attr ] )*
#[derive(std::fmt::Debug, Clone)]
$quant struct $name {
$( $arg: $typ, )*
expr_inst: $crate::interpreted::ExprInst,
}
impl $crate::ddispatch::Responder for $name {}
$crate::atomic_redirect!($name, expr_inst);
$crate::atomic_impl!($name);
$crate::externfn_impl!(
$name,
|this: Self, expr_inst: $crate::interpreted::ExprInst| {
let $added $( :$added_typ )? =
$crate::write_fn_step!(@CONV this.expr_inst $(, $xname $extract )?);
Ok($next{
$( $arg: this.$arg.clone(), )*
$added, expr_inst
})
}
);
};
// write final stage
(
$( #[ $attr:meta ] )* $quant:vis $name:ident {
$( $arg:ident: $typ:ty ),*
}
$added:ident $(: $added_typ:ty )? $( = $xname:ident => $extract:expr )? ;
$process:expr
) => {
$( #[ $attr ] )*
#[derive(std::fmt::Debug, Clone)]
$quant struct $name {
$( $arg: $typ, )*
expr_inst: $crate::interpreted::ExprInst,
}
$crate::atomic_redirect!($name, expr_inst);
impl $crate::ddispatch::Responder for $name {}
$crate::atomic_impl!(
$name,
|Self{ $($arg, )* expr_inst }, _| {
let $added $(: $added_typ )? =
$crate::write_fn_step!(@CONV expr_inst $(, $xname $extract )?);
$process
}
);
};
// Write conversion expression for an ExprInst
(@CONV $locxname:expr, $xname:ident $extract:expr) => {
{
let $xname = $locxname;
match $extract {
Err(e) => return Err(e),
Ok(r) => r,
}
}
};
(@CONV $locxname:expr) => {
($locxname).downcast()?
};
}

24
src/interpreter/context.rs
View File

@@ -26,3 +26,27 @@ pub struct Return {
/// If true, the next run would not modify the expression
pub inert: bool,
}
impl Return {
/// Check if gas has run out. Returns false if gas is not being used
pub fn preempted(&self) -> bool { self.gas.map_or(false, |g| g == 0) }
/// Returns a general report of the return
pub fn status(&self) -> ReturnStatus {
if self.preempted() {
ReturnStatus::Preempted
} else if self.inert {
ReturnStatus::Inert
} else {
ReturnStatus::Active
}
}
}
/// Possible states of a [Return]
pub enum ReturnStatus {
/// The data is not normalizable any further
Inert,
/// Gas is being used and it ran out
Preempted,
/// Normalization stopped for a different reason and should continue.
Active,
}

2
src/interpreter/mod.rs
View File

@@ -5,7 +5,7 @@ mod error;
mod handler;
mod run;
pub use context::{Context, Return};
pub use context::{Context, Return, ReturnStatus};
pub use error::RuntimeError;
pub use handler::{run_handler, HandlerRes, HandlerTable};
pub use run::run;

1
src/lib.rs
View File

@@ -10,7 +10,6 @@
pub mod error;
pub mod facade;
pub mod foreign;
mod foreign_macros;
pub mod interner;
pub mod interpreter;
mod parse;

2
src/pipeline/mod.rs
View File

@@ -1,7 +1,7 @@
//! Loading Orchid modules from source
mod dealias;
pub mod file_loader;
mod import_abs_path;
mod dealias;
mod parse_layer;
mod project_tree;
mod source_loader;

2
src/representations/ast.rs
View File

@@ -179,7 +179,7 @@ impl<N: NameLike> Clause<N> {
Some(Self::S('(', Rc::new(exprs.to_vec())))
}
}
/// Convert with identical meaning
#[must_use]
pub fn from_exprv(exprv: &Rc<Vec<Expr<N>>>) -> Option<Clause<N>> {

26
src/representations/interpreted.rs
View File

@@ -57,6 +57,10 @@ pub trait TryFromExprInst: Sized {
fn from_exi(exi: ExprInst) -> Result<Self, Rc<dyn ExternError>>;
}
impl TryFromExprInst for ExprInst {
fn from_exi(exi: ExprInst) -> Result<Self, Rc<dyn ExternError>> { Ok(exi) }
}
/// A wrapper around expressions to handle their multiple occurences in
/// the tree together
#[derive(Clone)]
@@ -253,6 +257,28 @@ impl Clause {
clause: self,
})))
}
/// Construct an application step
pub fn apply(f: Self, x: Self) -> Self {
Self::Apply { f: f.wrap(), x: x.wrap() }
}
/// Construct a lambda that uses its argument. See also [Clause::constfn]
pub fn lambda(arg: PathSet, body: Self) -> Self {
Self::Lambda { args: Some(arg), body: body.wrap() }
}
/// Construct a lambda that discards its argument. See also [Clause::lambda]
pub fn constfn(body: Self) -> Self {
Self::Lambda { args: None, body: body.wrap() }
}
/// Construct a lambda that picks its argument and places it in a directly
/// descendant slot. Body must be a [Clause::LambdaArg] nested in an arbitrary
/// number of [Clause::Lambda]s
pub fn pick(body: Self) -> Self {
Self::Lambda { args: Some(PathSet::pick()), body: body.wrap() }
}
}
impl Display for Clause {

23
src/representations/path_set.rs
View File

@@ -15,6 +15,29 @@ pub struct PathSet {
pub next: Option<(Rc<PathSet>, Rc<PathSet>)>,
}
impl PathSet {
/// Create a path set for more than one target
pub fn branch(
steps: impl IntoIterator<Item = Side>,
left: Self,
right: Self,
) -> Self {
let steps = Rc::new(steps.into_iter().collect());
Self { steps, next: Some((Rc::new(left), Rc::new(right))) }
}
/// Create a path set for one target
pub fn end(steps: impl IntoIterator<Item = Side>) -> Self {
Self { steps: Rc::new(steps.into_iter().collect()), next: None }
}
/// Create a path set points to a slot that is a direct
/// child of the given lambda with no applications. In essence, this means
/// that this argument will be picked as the value of the expression after an
/// arbitrary amount of subsequent discarded parameters.
pub fn pick() -> Self { Self { steps: Rc::new(vec![]), next: None } }
}
impl Debug for PathSet {
fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
for s in self.steps.as_ref() {

2
src/systems/assertion_error.rs
View File

@@ -19,7 +19,7 @@ impl AssertionError {
location: Location,
message: &'static str,
) -> Result<T, Rc<dyn ExternError>> {
return Err(Self { location, message }.into_extern());
return Err(Self::ext(location, message));
}
/// Construct and upcast to [ExternError]

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

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

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

@@ -12,26 +12,24 @@ use rust_embed::RustEmbed;
use crate::facade::{IntoSystem, System};
use crate::foreign::cps_box::{init_cps, CPSBox};
use crate::foreign::{Atomic, ExternError, InertAtomic};
use crate::interpreted::ExprInst;
use crate::foreign::{xfn_2ary, Atomic, ExternError, InertAtomic, XfnResult};
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::{define_fn, ConstTree, Interner};
use crate::{ConstTree, Interner};
#[derive(Debug, Clone)]
struct Timer {
recurring: Boolean,
duration: NotNan<f64>,
delay: NotNan<f64>,
}
define_fn! {expr=x in
SetTimer {
recurring: Boolean,
duration: NotNan<f64>
} => Ok(init_cps(2, Timer{ recurring, duration }))
pub fn set_timer(recurring: Boolean, delay: NotNan<f64>) -> XfnResult<Clause> {
Ok(init_cps(2, Timer { recurring, delay }))
}
#[derive(Clone)]
@@ -135,7 +133,7 @@ impl<'a> IntoSystem<'a> for AsynchSystem<'a> {
move |t: Box<CPSBox<Timer>>| {
let mut polly = polly.borrow_mut();
let (timeout, action, cont) = t.unpack2();
let duration = Duration::from_secs_f64(*timeout.duration);
let duration = Duration::from_secs_f64(*timeout.delay);
let cancel_timer = if timeout.recurring.0 {
CancelTimer(Rc::new(polly.set_interval(duration, action)))
} else {
@@ -186,7 +184,7 @@ impl<'a> IntoSystem<'a> for AsynchSystem<'a> {
constants: ConstTree::namespace(
[i.i("system"), i.i("async")],
ConstTree::tree([
(i.i("set_timer"), ConstTree::xfn(SetTimer)),
(i.i("set_timer"), ConstTree::xfn(xfn_2ary(set_timer))),
(i.i("yield"), ConstTree::atom(Yield)),
]),
)

6
src/systems/cast_exprinst.rs
View File

@@ -15,8 +15,10 @@ use crate::{Location, Primitive};
pub fn get_literal(
exi: ExprInst,
) -> Result<(Literal, Location), Rc<dyn ExternError>> {
(exi.get_literal())
.map_err(|exi| AssertionError::ext(exi.location(), "literal"))
(exi.get_literal()).map_err(|exi| {
eprintln!("failed to get literal from {:?}", exi.expr().clause);
AssertionError::ext(exi.location(), "literal")
})
}
// ######## Automatically ########

50
src/systems/codegen.rs
View File

@@ -1,38 +1,27 @@
//! Utilities for generating Orchid code in Rust
use std::rc::Rc;
use crate::interpreted::{Clause, ExprInst};
use crate::utils::unwrap_or;
use crate::{PathSet, Side};
/// Convert a rust Option into an Orchid Option
pub fn orchid_opt(x: Option<ExprInst>) -> Clause {
if let Some(x) = x { some(x) } else { none() }
}
/// Constructs an instance of the orchid value Some wrapping the given
/// [ExprInst].
///
/// Takes two expressions and calls the second with the given data
fn some(x: ExprInst) -> Clause {
Clause::Lambda {
args: None,
body: Clause::Lambda {
args: Some(PathSet { steps: Rc::new(vec![Side::Left]), next: None }),
body: Clause::Apply { f: Clause::LambdaArg.wrap(), x }.wrap(),
}
.wrap(),
pub fn opt(x: Option<ExprInst>) -> Clause {
match x {
Some(x) => Clause::constfn(Clause::lambda(
PathSet::end([Side::Left]),
Clause::Apply { f: Clause::LambdaArg.wrap(), x },
)),
None => Clause::pick(Clause::constfn(Clause::LambdaArg)),
}
}
/// Constructs an instance of the orchid value None
///
/// Takes two expressions and returns the first
fn none() -> Clause {
Clause::Lambda {
args: Some(PathSet { steps: Rc::new(vec![]), next: None }),
body: Clause::Lambda { args: None, body: Clause::LambdaArg.wrap() }.wrap(),
/// Convert a rust Result into an Orchid Result
pub fn res(x: Result<ExprInst, ExprInst>) -> Clause {
let mk_body = |x| Clause::Apply { f: Clause::LambdaArg.wrap(), x };
let pick_fn = |b| Clause::lambda(PathSet::end([Side::Left]), b);
match x {
Ok(x) => Clause::constfn(pick_fn(mk_body(x))),
Err(x) => pick_fn(Clause::constfn(mk_body(x))),
}
}
@@ -40,18 +29,17 @@ fn none() -> Clause {
/// values to the callback in order.
pub fn tuple(data: impl IntoIterator<Item = ExprInst>) -> Clause {
let mut steps = Vec::new();
let mut body = Clause::LambdaArg.wrap();
let mut body = Clause::LambdaArg;
for x in data.into_iter() {
steps.push(Side::Left);
body = Clause::Apply { f: body, x }.wrap()
body = Clause::Apply { f: body.wrap(), x }
}
let path_set = PathSet { next: None, steps: Rc::new(steps) };
Clause::Lambda { args: Some(path_set), body }
Clause::lambda(PathSet::end(steps), body)
}
#[cfg(test)]
mod test {
use crate::systems::codegen::tuple;
use crate::systems::codegen::tuple;
#[test]
fn tuple_printer() {
@@ -69,5 +57,5 @@ pub fn call(f: ExprInst, args: impl IntoIterator<Item = ExprInst>) -> Clause {
/// Build an Orchid list from a Rust iterator
pub fn list(items: impl IntoIterator<Item = ExprInst>) -> Clause {
let mut iter = items.into_iter();
orchid_opt(iter.next().map(|it| tuple([it, list(iter).wrap()]).wrap()))
opt(iter.next().map(|it| tuple([it, list(iter).wrap()]).wrap()))
}

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

@@ -1,39 +1,63 @@
use std::ffi::OsString;
use std::fs::File;
use std::io::{BufReader, Read, Write};
use std::path::Path;
use std::path::{Path, PathBuf};
use hashbrown::HashMap;
use itertools::Itertools;
use super::osstring::os_string_lib;
use crate::ddispatch::Responder;
use crate::facade::{IntoSystem, System};
use crate::foreign::cps_box::{init_cps, CPSBox};
use crate::foreign::{Atomic, InertAtomic};
use crate::foreign::{
xfn_1ary, xfn_2ary, Atomic, AtomicReturn, InertAtomic, XfnResult,
};
use crate::interpreted::{Clause, ExprInst};
use crate::interpreter::HandlerTable;
use crate::systems::codegen::{call, list, orchid_opt, tuple};
use crate::systems::io::wrap_io_error;
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::{define_fn, ConstTree, OrcString};
use crate::ConstTree;
#[derive(Debug, Clone)]
pub struct ReadFileCmd(OrcString);
pub struct CurrentDir;
impl Responder for CurrentDir {}
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 }
fn run(
self: Box<Self>,
ctx: crate::interpreter::Context,
) -> crate::foreign::AtomicResult {
let cwd = std::env::current_dir()
.map_err(|e| RuntimeError::ext(e.to_string(), "reading CWD"))?;
Ok(AtomicReturn {
clause: cwd.into_os_string().atom_cls(),
gas: ctx.gas.map(|g| g - 1),
inert: false,
})
}
}
#[derive(Debug, Clone)]
pub struct ReadFileCmd(OsString);
impl InertAtomic for ReadFileCmd {
fn type_str() -> &'static str { "readfile command" }
}
#[derive(Debug, Clone)]
pub struct ReadDirCmd(OrcString);
pub struct ReadDirCmd(OsString);
impl InertAtomic for ReadDirCmd {
fn type_str() -> &'static str { "readdir command" }
}
#[derive(Debug, Clone)]
pub struct WriteFile {
name: OrcString,
name: OsString,
append: bool,
}
impl InertAtomic for WriteFile {
@@ -43,15 +67,14 @@ impl InertAtomic for WriteFile {
#[must_use]
fn read_file(sched: &SeqScheduler, cmd: CPSBox<ReadFileCmd>) -> ExprInst {
let (ReadFileCmd(name), succ, fail, cont) = cmd.unpack3();
let name = name.get_string();
let cancel = sched.run_orphan(
move |_| File::open(name),
|file, _| match file {
Err(e) => vec![call(fail, [wrap_io_error(e)]).wrap()],
Ok(f) => {
let source =
SharedHandle::wrap(BufReader::new(Box::new(f) as Box<dyn Read>));
vec![call(succ, [source.atom_exi()]).wrap()]
let source: Source =
BufReader::new(Box::new(f) as Box<dyn Read + Send>);
vec![call(succ, [SharedHandle::wrap(source).atom_exi()]).wrap()]
},
},
);
@@ -61,7 +84,6 @@ fn read_file(sched: &SeqScheduler, cmd: CPSBox<ReadFileCmd>) -> ExprInst {
#[must_use]
fn read_dir(sched: &SeqScheduler, cmd: CPSBox<ReadDirCmd>) -> ExprInst {
let (ReadDirCmd(name), succ, fail, cont) = cmd.unpack3();
let name = name.get_string();
let cancel = sched.run_orphan(
move |_| {
Path::new(&name)
@@ -73,9 +95,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([os_str_cls(n)?.wrap(), Boolean(d).atom_exi()]).wrap())
})
.map(|(n, d)| Ok(tuple([n.atom_exi(), Boolean(d).atom_exi()]).wrap()))
.collect::<Result<Vec<_>, Clause>>();
match converted {
Err(e) => vec![call(fail, [e.wrap()]).wrap()],
@@ -90,7 +110,6 @@ fn read_dir(sched: &SeqScheduler, cmd: CPSBox<ReadDirCmd>) -> ExprInst {
#[must_use]
pub fn write_file(sched: &SeqScheduler, cmd: CPSBox<WriteFile>) -> ExprInst {
let (WriteFile { name, append }, succ, fail, cont) = cmd.unpack3();
let name = name.get_string();
let cancel = sched.run_orphan(
move |_| File::options().write(true).append(append).open(name),
|file, _| match file {
@@ -104,61 +123,38 @@ pub fn write_file(sched: &SeqScheduler, cmd: CPSBox<WriteFile>) -> ExprInst {
call(cont, [init_cps(1, cancel).wrap()]).wrap()
}
#[derive(Debug, Clone)]
pub struct InvalidString(OsString);
impl InertAtomic for InvalidString {
fn type_str() -> &'static str { "invalidstring error" }
pub fn open_file_read_cmd(name: OsString) -> XfnResult<Clause> {
Ok(init_cps(3, ReadFileCmd(name)))
}
fn os_str_cls(str: OsString) -> Result<Clause, Clause> {
(str.into_string())
.map_err(|e| InvalidString(e).atom_cls())
.map(|s| OrcString::from(s).cls())
pub fn read_dir_cmd(name: OsString) -> XfnResult<Clause> {
Ok(init_cps(3, ReadDirCmd(name)))
}
define_fn! {
pub IsInvalidString = |x| {
Ok(Boolean(x.downcast::<InvalidString>().is_ok()).atom_cls())
};
pub OpenFileRead = |x| Ok(init_cps(3, ReadFileCmd(x.downcast()?)));
pub ReadDir = |x| Ok(init_cps(3, ReadDirCmd(x.downcast()?)));
pub OpenFileWrite = |x| {
Ok(init_cps(3, WriteFile{ name: x.downcast()?, append: false }))
};
pub OpenFileAppend = |x| {
Ok(init_cps(3, WriteFile{ name: x.downcast()?, append: true }))
};
pub fn open_file_write_cmd(name: OsString) -> XfnResult<Clause> {
Ok(init_cps(3, WriteFile { name, append: false }))
}
pub JoinPaths { root: OrcString, sub: OrcString } => {
let res = Path::new(root.as_str())
.join(sub.as_str())
.into_os_string();
os_str_cls(res.clone()).map_err(|_| RuntimeError::ext(
format!("result {res:?} contains illegal characters"),
"joining paths"
))
};
pub PopPath = |x| {
eprintln!("argument is {x}");
let arg = x.downcast::<OrcString>()?;
let full_path = Path::new(arg.as_str());
let parent = unwrap_or! {full_path.parent(); {
return Ok(orchid_opt(None))
}};
let sub = unwrap_or! {full_path.file_name(); {
return Ok(orchid_opt(None))
}};
Ok(orchid_opt(Some(tuple(
[parent.as_os_str(), sub]
.into_iter()
.map(|s| os_str_cls(s.to_owned()).map_err(|_| RuntimeError::ext(
format!("Result {s:?} contains illegal characters"),
"splitting a path"
)))
.map_ok(Clause::wrap)
.collect::<Result<Vec<_>, _>>()?
).wrap())))
}
pub fn open_file_append_cmd(name: OsString) -> XfnResult<Clause> {
Ok(init_cps(3, WriteFile { name, append: true }))
}
pub fn join_paths(root: OsString, sub: OsString) -> XfnResult<OsString> {
let mut path = PathBuf::from(root);
path.push(sub);
Ok(path.into_os_string())
}
pub fn pop_path(path: OsString) -> XfnResult<Clause> {
let mut path = PathBuf::from(path);
let sub = unwrap_or! {path.file_name(); {
return Ok(opt(None))
}}
.to_owned();
debug_assert!(path.pop(), "file_name above returned Some");
Ok(opt(Some(
tuple([path.into_os_string().atom_exi(), sub.atom_exi()]).wrap(),
)))
}
/// A rudimentary system to read and write files.
@@ -187,14 +183,14 @@ impl IntoSystem<'static> for DirectFS {
constants: ConstTree::namespace(
[i.i("system"), i.i("directfs")],
ConstTree::tree([
(i.i("is_invalid_string"), ConstTree::xfn(IsInvalidString)),
(i.i("readfile"), ConstTree::xfn(OpenFileRead)),
(i.i("readdir"), ConstTree::xfn(ReadDir)),
(i.i("writefile"), ConstTree::xfn(OpenFileWrite)),
(i.i("appendfile"), ConstTree::xfn(OpenFileAppend)),
(i.i("join_paths"), ConstTree::xfn(JoinPaths)),
(i.i("pop_path"), ConstTree::xfn(PopPath)),
]),
(i.i("read_file"), ConstTree::xfn(xfn_1ary(open_file_read_cmd))),
(i.i("read_dir"), ConstTree::xfn(xfn_1ary(read_dir_cmd))),
(i.i("write_file"), ConstTree::xfn(xfn_1ary(open_file_write_cmd))),
(i.i("append_file"), ConstTree::xfn(xfn_1ary(open_file_append_cmd))),
(i.i("join_paths"), ConstTree::xfn(xfn_2ary(join_paths))),
(i.i("pop_path"), ConstTree::xfn(xfn_1ary(pop_path))),
(i.i("cwd"), ConstTree::atom(CurrentDir)),
]) + os_string_lib(i),
)
.unwrap_tree(),
handlers,

1
src/systems/directfs/mod.rs
View File

@@ -1,5 +1,6 @@
//! A rudimentary system exposing methods for Orchid to interact with the file
//! system. All paths are strings.
mod commands;
mod osstring;
pub use commands::DirectFS;

28
src/systems/directfs/osstring.rs Normal file
View File

@@ -0,0 +1,28 @@
use std::ffi::OsString;
use crate::foreign::{xfn_1ary, InertAtomic, XfnResult};
use crate::{ConstTree, Interner, OrcString};
impl InertAtomic for OsString {
fn type_str() -> &'static str { "OsString" }
}
pub fn os_to_string(os: OsString) -> XfnResult<Result<String, OsString>> {
Ok(os.into_string())
}
pub fn string_to_os(str: OrcString) -> XfnResult<OsString> {
Ok(str.get_string().into())
}
pub fn os_print(os: OsString) -> XfnResult<String> {
Ok(os.into_string().unwrap_or_else(|e| e.to_string_lossy().to_string()))
}
pub fn os_string_lib(i: &Interner) -> ConstTree {
ConstTree::tree([
(i.i("os_to_string"), ConstTree::xfn(xfn_1ary(os_to_string))),
(i.i("string_to_os"), ConstTree::xfn(xfn_1ary(string_to_os))),
(i.i("os_print"), ConstTree::xfn(xfn_1ary(os_print))),
])
}

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

@@ -1,60 +1,47 @@
use super::flow::IOCmdHandlePack;
use super::instances::{
BRead, ReadCmd, SRead, WriteCmd, Sink, Source,
};
use super::instances::{BRead, ReadCmd, SRead, Sink, Source, WriteCmd};
use crate::foreign::cps_box::init_cps;
use crate::foreign::{Atom, Atomic};
use crate::foreign::{xfn_1ary, xfn_2ary, Atom, Atomic, XfnResult};
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, define_fn, ConstTree, Interner, Primitive};
use crate::{ast, ConstTree, Interner, Primitive};
define_fn! {
ReadString = |x| Ok(init_cps(3, IOCmdHandlePack{
cmd: ReadCmd::RStr(SRead::All),
handle: x.downcast()?
}));
ReadLine = |x| Ok(init_cps(3, IOCmdHandlePack{
cmd: ReadCmd::RStr(SRead::Line),
handle: x.downcast()?
}));
ReadBin = |x| Ok(init_cps(3, IOCmdHandlePack{
cmd: ReadCmd::RBytes(BRead::All),
handle: x.downcast()?
}));
ReadBytes { stream: SharedHandle<Source>, n: u64 } => {
Ok(init_cps(3, IOCmdHandlePack{
cmd: ReadCmd::RBytes(BRead::N(n.try_into().unwrap())),
handle: stream.clone()
}))
};
ReadUntil { stream: SharedHandle<Source>, pattern: u64 } => {
let delim = pattern.try_into().map_err(|_| RuntimeError::ext(
"greater than 255".to_string(),
"converting number to byte"
))?;
Ok(init_cps(3, IOCmdHandlePack{
cmd: ReadCmd::RBytes(BRead::Until(delim)),
handle: stream
}))
};
WriteStr { stream: SharedHandle<Sink>, string: OrcString } => {
Ok(init_cps(3, IOCmdHandlePack {
cmd: WriteCmd::WStr(string.get_string()),
handle: stream.clone(),
}))
};
WriteBin { stream: SharedHandle<Sink>, bytes: Binary } => {
Ok(init_cps(3, IOCmdHandlePack {
cmd: WriteCmd::WBytes(bytes),
handle: stream.clone(),
}))
};
Flush = |x| Ok(init_cps(3, IOCmdHandlePack {
cmd: WriteCmd::Flush,
handle: x.downcast()?
}))
type WriteHandle = SharedHandle<Sink>;
type ReadHandle = SharedHandle<Source>;
pub fn read_string(handle: ReadHandle) -> XfnResult<Clause> {
Ok(init_cps(3, IOCmdHandlePack { handle, cmd: ReadCmd::RStr(SRead::All) }))
}
pub fn read_line(handle: ReadHandle) -> XfnResult<Clause> {
Ok(init_cps(3, IOCmdHandlePack { handle, cmd: ReadCmd::RStr(SRead::Line) }))
}
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()));
Ok(init_cps(3, IOCmdHandlePack { cmd, handle }))
}
pub fn read_until(handle: ReadHandle, pattern: u64) -> XfnResult<Clause> {
let delim = pattern.try_into().map_err(|_| {
let msg = "greater than 255".to_string();
RuntimeError::ext(msg, "converting number to byte")
})?;
let cmd = ReadCmd::RBytes(BRead::Until(delim));
Ok(init_cps(3, IOCmdHandlePack { handle, cmd }))
}
pub fn write_str(handle: WriteHandle, string: OrcString) -> XfnResult<Clause> {
let cmd = WriteCmd::WStr(string.get_string());
Ok(init_cps(3, IOCmdHandlePack { handle, cmd }))
}
pub fn write_bin(handle: WriteHandle, bytes: Binary) -> XfnResult<Clause> {
Ok(init_cps(3, IOCmdHandlePack { handle, cmd: WriteCmd::WBytes(bytes) }))
}
pub fn flush(handle: WriteHandle) -> XfnResult<Clause> {
Ok(init_cps(3, IOCmdHandlePack { handle, cmd: WriteCmd::Flush }))
}
pub fn io_bindings<'a>(
@@ -64,14 +51,14 @@ pub fn io_bindings<'a>(
ConstTree::namespace(
[i.i("system"), i.i("io")],
ConstTree::tree([
(i.i("read_string"), ConstTree::xfn(ReadString)),
(i.i("read_line"), ConstTree::xfn(ReadLine)),
(i.i("read_bin"), ConstTree::xfn(ReadBin)),
(i.i("read_n_bytes"), ConstTree::xfn(ReadBytes)),
(i.i("read_until"), ConstTree::xfn(ReadUntil)),
(i.i("write_str"), ConstTree::xfn(WriteStr)),
(i.i("write_bin"), ConstTree::xfn(WriteBin)),
(i.i("flush"), ConstTree::xfn(Flush)),
(i.i("read_string"), ConstTree::xfn(xfn_1ary(read_string))),
(i.i("read_line"), ConstTree::xfn(xfn_1ary(read_line))),
(i.i("read_bin"), ConstTree::xfn(xfn_1ary(read_bin))),
(i.i("read_n_bytes"), ConstTree::xfn(xfn_2ary(read_bytes))),
(i.i("read_until"), ConstTree::xfn(xfn_2ary(read_until))),
(i.i("write_str"), ConstTree::xfn(xfn_2ary(write_str))),
(i.i("write_bin"), ConstTree::xfn(xfn_2ary(write_bin))),
(i.i("flush"), ConstTree::xfn(xfn_1ary(flush))),
]) + ConstTree::Tree(
std_streams
.into_iter()

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

@@ -8,5 +8,5 @@ mod instances;
mod service;
// pub use facade::{io_system, IOStream, IOSystem};
pub use instances::{wrap_io_error, Sink, Source};
pub use service::{Service, Stream, StreamTable};
pub use instances::{wrap_io_error, Source, Sink};

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

@@ -11,8 +11,8 @@ use super::busy::{BusyState, NextItemReportKind};
use super::Canceller;
use crate::facade::{IntoSystem, System};
use crate::foreign::cps_box::{init_cps, CPSBox};
use crate::foreign::InertAtomic;
use crate::interpreted::ExprInst;
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;
@@ -20,7 +20,7 @@ use crate::systems::AssertionError;
use crate::utils::ddispatch::Request;
use crate::utils::thread_pool::ThreadPool;
use crate::utils::{take_with_output, unwrap_or, IdMap};
use crate::{define_fn, ConstTree};
use crate::{ConstTree, Location};
enum SharedResource<T> {
Free(T),
@@ -127,19 +127,17 @@ impl InertAtomic for SealedOrTaken {
}
}
define_fn! {
pub TakeAndDrop = |x| {
let location = x.location();
match x.request() {
Some(t) => Ok(init_cps::<TakeCmd>(1, t)),
None => AssertionError::fail(location, "SharedHandle"),
}
};
IsTakenError = |x| {
Ok(Boolean(x.downcast::<SealedOrTaken>().is_ok()).atom_cls())
pub fn take_and_drop(x: ExprInst) -> XfnResult<Clause> {
match x.request() {
Some(t) => Ok(init_cps::<TakeCmd>(1, t)),
None => AssertionError::fail(Location::Unknown, "SharedHandle"),
}
}
pub fn is_taken_error(x: ExprInst) -> XfnResult<Boolean> {
Ok(Boolean(x.downcast::<SealedOrTaken>().is_ok()))
}
trait_set! {
/// The part of processing a blocking I/O task that cannot be done on a remote
/// thread, eg. because it accesses other systems or Orchid code.
@@ -334,8 +332,8 @@ impl IntoSystem<'static> for SeqScheduler {
constants: ConstTree::namespace(
[i.i("system"), i.i("scheduler")],
ConstTree::tree([
(i.i("is_taken_error"), ConstTree::xfn(IsTakenError)),
(i.i("take_and_drop"), ConstTree::xfn(TakeAndDrop)),
(i.i("is_taken_error"), ConstTree::xfn(xfn_1ary(is_taken_error))),
(i.i("take_and_drop"), ConstTree::xfn(xfn_1ary(take_and_drop))),
]),
)
.unwrap_tree(),

203
src/systems/stl/bin.rs
View File

@@ -4,11 +4,14 @@ use std::sync::Arc;
use itertools::Itertools;
use super::Boolean;
use crate::foreign::InertAtomic;
use crate::systems::codegen::{orchid_opt, tuple};
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::{define_fn, ConstTree, Interner, Literal};
use crate::{ConstTree, Interner, Literal};
/// A block of binary data
#[derive(Clone, Hash, PartialEq, Eq)]
@@ -33,114 +36,108 @@ impl Debug for Binary {
}
}
define_fn! {
/// Detect the number of bytes in the binary data block
pub Size = |x| {
Ok(Literal::Uint(x.downcast::<Binary>()?.0.len() as u64).into())
};
/// Append two binary data blocks
pub fn concatenate(a: Binary, b: Binary) -> XfnResult<Binary> {
let data = a.0.iter().chain(b.0.iter()).copied().collect();
Ok(Binary(Arc::new(data)))
}
expr=x in
/// Convert a number into a binary blob
pub FromNum {
size: u64,
is_little_endian: Boolean,
data: u64
} => {
if size > 8 {
RuntimeError::fail(
"more than 8 bytes requested".to_string(),
"converting number to binary"
)?
}
let bytes = if is_little_endian.0 {
data.to_le_bytes()[0..size as usize].to_vec()
} else {
data.to_be_bytes()[8 - size as usize..].to_vec()
};
Ok(Binary(Arc::new(bytes)).atom_cls())
};
/// Read a number from a binary blob
pub GetNum {
buf: Binary,
loc: u64,
size: u64,
is_little_endian: Boolean
} => {
if buf.0.len() < (loc + size) as usize {
RuntimeError::fail(
"section out of range".to_string(),
"reading number from binary data"
)?
}
if 8 < size {
RuntimeError::fail(
"more than 8 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_little_endian.0 {
data[0..size as usize].copy_from_slice(section);
u64::from_le_bytes(data)
} else {
data[8 - size as usize..].copy_from_slice(section);
u64::from_be_bytes(data)
};
Ok(Literal::Uint(num).into())
};
/// Append two binary data blocks
pub Concatenate { a: Binary, b: Binary } => {
let data = a.0.iter().chain(b.0.iter()).copied().collect();
Ok(Binary(Arc::new(data)).atom_cls())
};
/// Extract a subsection of the binary data
pub Slice { s: Binary, i: u64, len: u64 } => {
if i + len < s.0.len() as u64 {
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)).atom_cls())
};
/// Return the index where the first argument first contains the second,
/// if any
pub Find { haystack: Binary, needle: Binary } => {
let found = iter_find(haystack.0.iter(), needle.0.iter());
Ok(orchid_opt(found.map(|x| Literal::Uint(x as u64).into())))
};
/// Split binary data block into two smaller blocks
pub Split { bin: Binary, i: u64 } => {
if bin.0.len() < i as usize {
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(),
]))
/// 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 {
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)))
}
/// 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())))
}
/// Split binary data block into two smaller blocks
pub fn split(bin: Binary, i: u64) -> XfnResult<Clause> {
if bin.0.len() < i as usize {
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(),
]))
}
/// 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 {
RuntimeError::fail(
"section out of range".to_string(),
"reading number from binary data",
)?
}
if 8 < size {
RuntimeError::fail(
"more than 8 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)
} else {
data[8 - size as usize..].copy_from_slice(section);
u64::from_be_bytes(data)
};
Ok(Literal::Uint(num))
}
/// Convert a number into a blob
pub fn from_num(size: u64, is_le: Boolean, data: u64) -> XfnResult<Binary> {
if size > 8 {
RuntimeError::fail(
"more than 8 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()
};
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 bin(i: &Interner) -> ConstTree {
ConstTree::tree([(
i.i("bin"),
ConstTree::tree([
(i.i("concat"), ConstTree::xfn(Concatenate)),
(i.i("slice"), ConstTree::xfn(Slice)),
(i.i("find"), ConstTree::xfn(Find)),
(i.i("split"), ConstTree::xfn(Split)),
(i.i("size"), ConstTree::xfn(Size)),
(i.i("concat"), ConstTree::xfn(xfn_2ary(concatenate))),
(i.i("slice"), ConstTree::xfn(xfn_3ary(slice))),
(i.i("find"), ConstTree::xfn(xfn_2ary(find))),
(i.i("split"), ConstTree::xfn(xfn_2ary(split))),
(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))),
]),
)])
}

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

@@ -1,10 +1,8 @@
use std::rc::Rc;
use crate::foreign::InertAtomic;
use crate::foreign::{xfn_1ary, xfn_2ary, InertAtomic, XfnResult};
use crate::interner::Interner;
use crate::representations::interpreted::Clause;
use crate::systems::AssertionError;
use crate::{define_fn, ConstTree, Literal, Location, PathSet};
use crate::{ConstTree, Literal, Location};
/// Booleans exposed to Orchid
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
@@ -17,46 +15,38 @@ impl From<bool> for Boolean {
fn from(value: bool) -> Self { Self(value) }
}
define_fn! {
/// 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.
IfThenElse = |x| x.downcast().map(|Boolean(b)| if b {Clause::Lambda {
args: Some(PathSet { steps: Rc::new(vec![]), next: None }),
body: Clause::Lambda {
args: None,
body: Clause::LambdaArg.wrap()
}.wrap(),
}} else {Clause::Lambda {
args: None,
body: Clause::Lambda {
args: Some(PathSet { steps: Rc::new(vec![]), next: None }),
body: Clause::LambdaArg.wrap(),
}.wrap(),
}});
/// 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 {
true => Clause::pick(Clause::constfn(Clause::LambdaArg)),
false => Clause::constfn(Clause::pick(Clause::LambdaArg)),
})
}
expr=x in
/// Compares the inner values if
///
/// - both are string,
/// - both are either uint or num
Equals { a: Literal, b: Literal } => Ok(Boolean::from(match (a, b) {
/// Compares the inner values if
///
/// - both are string,
/// - 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")?,
}).atom_cls())
}))
}
pub fn bool(i: &Interner) -> ConstTree {
ConstTree::tree([(
i.i("bool"),
ConstTree::tree([
(i.i("ifthenelse"), ConstTree::xfn(IfThenElse)),
(i.i("equals"), ConstTree::xfn(Equals)),
(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))),
]),

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

@@ -2,48 +2,53 @@ use chumsky::Parser;
use ordered_float::NotNan;
use super::ArithmeticError;
use crate::foreign::ExternError;
use crate::foreign::{xfn_1ary, ExternError, XfnResult};
use crate::interner::Interner;
use crate::interpreted::Clause;
use crate::parse::{float_parser, int_parser};
use crate::systems::cast_exprinst::get_literal;
use crate::systems::AssertionError;
use crate::{define_fn, ConstTree, Literal};
use crate::{ConstTree, Literal, Location};
define_fn! {
/// parse a number. Accepts the same syntax Orchid does.
ToFloat = |x| match get_literal(x)? {
(Literal::Str(s), loc) => float_parser()
/// 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_err(|_| AssertionError::ext(loc, "float syntax")),
(Literal::Num(n), _) => Ok(n),
(Literal::Uint(i), _) => NotNan::new(i as f64)
.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()),
}.map(|nn| Literal::Num(nn).into());
}
}
/// Parse an unsigned integer. Accepts the same formats Orchid does. If the
/// input is a number, floors it.
ToUint = |x| match get_literal(x)? {
(Literal::Str(s), loc) => int_parser()
/// 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_err(|_| AssertionError::ext(loc, "int syntax")),
(Literal::Num(n), _) => Ok(n.floor() as u64),
(Literal::Uint(i), _) => Ok(i),
}.map(|u| Literal::Uint(u).into());
.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),
}
}
/// Convert a literal to a string using Rust's conversions for floats, chars and
/// uints respectively
ToString = |x| Ok(match get_literal(x)?.0 {
Literal::Uint(i) => Clause::from(Literal::Str(i.to_string().into())),
Literal::Num(n) => Clause::from(Literal::Str(n.to_string().into())),
s@Literal::Str(_) => Clause::from(s),
/// 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 conv(i: &Interner) -> ConstTree {
ConstTree::tree([
(i.i("to_float"), ConstTree::xfn(ToFloat)),
(i.i("to_uint"), ConstTree::xfn(ToUint)),
(i.i("to_string"), ConstTree::xfn(ToString)),
(i.i("to_float"), ConstTree::xfn(xfn_1ary(to_float))),
(i.i("to_uint"), ConstTree::xfn(xfn_1ary(to_uint))),
(i.i("to_string"), ConstTree::xfn(xfn_1ary(to_string))),
])
}

32
src/systems/stl/inspect.rs
View File

@@ -1,32 +1,18 @@
use std::fmt::Debug;
use crate::foreign::{Atomic, AtomicReturn};
use crate::foreign::{ExternFn, XfnResult};
use crate::interpreted::Clause;
use crate::interpreter::Context;
use crate::representations::interpreted::ExprInst;
use crate::utils::ddispatch::Responder;
use crate::{write_fn_step, ConstTree, Interner};
write_fn_step! {
/// Print and return whatever expression is in the argument without
/// normalizing it.
Inspect > Inspect1
}
use crate::{ConstTree, Interner};
#[derive(Debug, Clone)]
struct Inspect1 {
expr_inst: ExprInst,
}
impl Responder for Inspect1 {}
impl Atomic for Inspect1 {
fn as_any(self: Box<Self>) -> Box<dyn std::any::Any> { self }
fn as_any_ref(&self) -> &dyn std::any::Any { self }
fn run(self: Box<Self>, ctx: Context) -> crate::foreign::AtomicResult {
println!("{}", self.expr_inst);
Ok(AtomicReturn {
clause: self.expr_inst.expr().clause.clone(),
gas: ctx.gas.map(|g| g - 1),
inert: false,
})
struct Inspect;
impl ExternFn for Inspect {
fn name(&self) -> &str { "inspect" }
fn apply(self: Box<Self>, arg: ExprInst, _: Context) -> XfnResult<Clause> {
println!("{arg}");
Ok(arg.expr().clause.clone())
}
}

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

@@ -51,8 +51,8 @@ export const reduce := \list.\f. do{
]--
export const filter := \list.\f. (
pop list end \head.\tail.
if (f el)
then cons el (filter tail f)
if (f head)
then cons head (filter tail f)
else filter tail f
)

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

@@ -59,7 +59,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) with
recursive r (m, normal=empty)
list::pop m normal \head.\tail.
r tail $ set normal (fst head) (snd head)
)

113
src/systems/stl/num.rs
View File

@@ -3,13 +3,13 @@ use std::rc::Rc;
use ordered_float::NotNan;
use super::ArithmeticError;
use crate::foreign::ExternError;
use crate::foreign::{xfn_2ary, ExternError, ToClause, XfnResult};
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::{define_fn, ConstTree, Interner};
use crate::{ConstTree, Interner};
// region: Numeric, type to handle floats and uints together
@@ -51,9 +51,9 @@ impl TryFromExprInst for Numeric {
}
}
impl From<Numeric> for Clause {
fn from(value: Numeric) -> Self {
Clause::P(Primitive::Literal(match 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),
}))
@@ -62,65 +62,66 @@ impl From<Numeric> for Clause {
// endregion
// region: operations
define_fn! {
/// Add two numbers. If they're both uint, the output is uint. If either is
/// number, the output is number.
Add { a: Numeric, b: Numeric } => match (a, b) {
(Numeric::Uint(a), Numeric::Uint(b)) => {
a.checked_add(b)
.map(Numeric::Uint)
.ok_or_else(|| ArithmeticError::Overflow.into_extern())
}
/// Add two numbers. If they're both uint, the output is uint. If either is
/// number, the output is number.
pub fn add(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
match (a, b) {
(Numeric::Uint(a), Numeric::Uint(b)) => a
.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),
}.map(Numeric::into);
(Numeric::Num(a), Numeric::Uint(b))
| (Numeric::Uint(b), Numeric::Num(a)) => Numeric::num(*a + b as f64),
}
}
/// Subtract a number from another. Always returns Number.
Subtract { a: Numeric, b: Numeric } => match (a, b) {
/// 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),
}.map(Numeric::into);
}
}
/// Multiply two numbers. If they're both uint, the output is uint. If either
/// is number, the output is number.
Multiply { a: Numeric, b: Numeric } => match (a, b) {
(Numeric::Uint(a), Numeric::Uint(b)) => {
a.checked_mul(b)
.map(Numeric::Uint)
.ok_or_else(|| ArithmeticError::Overflow.into_extern())
}
/// Multiply two numbers. If they're both uint, the output is uint. If either
/// is number, the output is number.
pub fn multiply(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
match (a, b) {
(Numeric::Uint(a), Numeric::Uint(b)) => a
.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),
}.map(Numeric::into);
(Numeric::Uint(a), Numeric::Num(b))
| (Numeric::Num(b), Numeric::Uint(a)) => Numeric::num(a as f64 * *b),
}
}
/// Divide a number by another. Always returns Number.
Divide { a: Numeric, b: Numeric } => {
let a: f64 = a.as_f64();
let b: f64 = b.as_f64();
if b == 0.0 {
return Err(ArithmeticError::DivByZero.into_extern())
}
Numeric::num(a / b).map(Numeric::into)
};
/// Divide a number by another. Always returns Number.
pub fn divide(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
let a: f64 = a.as_f64();
let b: f64 = b.as_f64();
if b == 0.0 {
return Err(ArithmeticError::DivByZero.into_extern());
}
Numeric::num(a / b)
}
/// Take the remainder of two numbers. If they're both uint, the output is
/// uint. If either is number, the output is number.
Remainder { a: Numeric, b: Numeric } => match (a, b) {
(Numeric::Uint(a), Numeric::Uint(b)) => {
a.checked_rem(b)
.map(Numeric::Uint)
.ok_or_else(|| ArithmeticError::DivByZero.into_extern())
}
/// Take the remainder of two numbers. If they're both uint, the output is
/// uint. If either is number, the output is number.
pub fn remainder(a: Numeric, b: Numeric) -> XfnResult<Numeric> {
match (a, b) {
(Numeric::Uint(a), Numeric::Uint(b)) => a
.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),
}.map(Numeric::into)
}
}
// endregion
@@ -129,11 +130,11 @@ pub fn num(i: &Interner) -> ConstTree {
ConstTree::tree([(
i.i("num"),
ConstTree::tree([
(i.i("add"), ConstTree::xfn(Add)),
(i.i("subtract"), ConstTree::xfn(Subtract)),
(i.i("multiply"), ConstTree::xfn(Multiply)),
(i.i("divide"), ConstTree::xfn(Divide)),
(i.i("remainder"), ConstTree::xfn(Remainder)),
(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))),
]),
)])
}

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

@@ -1,8 +1,9 @@
use std::fmt::Display;
use std::rc::Rc;
use crate::foreign::ExternError;
use crate::{define_fn, ConstTree, Interner, OrcString};
use crate::foreign::{xfn_1ary, ExternError, XfnResult};
use crate::interpreted::Clause;
use crate::{ConstTree, Interner, OrcString};
/// An unrecoverable error in Orchid land. Because Orchid is lazy, this only
/// invalidates expressions that reference the one that generated it.
@@ -16,14 +17,12 @@ impl Display for OrchidPanic {
impl ExternError for OrchidPanic {}
define_fn! {
/// Takes a message, returns an [ExternError] unconditionally.
Panic = |x| {
let msg = Rc::new(x.downcast::<OrcString>()?.get_string());
Err(OrchidPanic(msg).into_extern())
}
/// Takes a message, returns an [ExternError] unconditionally.
pub fn orc_panic(msg: OrcString) -> XfnResult<Clause> {
// any return value would work, but Clause is the simplest
Err(OrchidPanic(Rc::new(msg.get_string())).into_extern())
}
pub fn panic(i: &Interner) -> ConstTree {
ConstTree::tree([(i.i("panic"), ConstTree::xfn(Panic))])
ConstTree::tree([(i.i("panic"), ConstTree::xfn(xfn_1ary(orc_panic)))])
}

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

@@ -10,17 +10,17 @@ export macro do {
}
export macro do {
...$statement ; ...$rest:1
} =0x2p130=> statement (...$statement) do { ...$rest }
export macro do { ...$return } =0x1p130=> ...$return
} =0x2p130=> statement (...$statement) (do { ...$rest })
export macro do { ...$return } =0x1p130=> (...$return)
export ::do
export macro statement (let $name = ...$value) ...$next =0x1p230=> (
export macro statement (let $name = ...$value) (...$next) =0x1p230=> (
( \$name. ...$next) (...$value)
)
export macro statement (cps ...$names = ...$operation:1) ...$next =0x2p230=> (
export macro statement (cps ...$names = ...$operation:1) (...$next) =0x2p230=> (
(...$operation) ( (...$names) => ...$next )
)
export macro statement (cps ...$operation) ...$next =0x1p230=> (
export macro statement (cps ...$operation) (...$next) =0x1p230=> (
(...$operation) (...$next)
)

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

@@ -0,0 +1,10 @@
import std::panic
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 flatten := \result. result err \res. res
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

@@ -3,11 +3,11 @@ use std::ops::Deref;
use std::rc::Rc;
use crate::foreign::cps_box::{const_cps, init_cps, CPSBox};
use crate::foreign::{Atomic, InertAtomic};
use crate::interpreted::ExprInst;
use crate::foreign::{xfn_1ary, Atomic, InertAtomic, XfnResult};
use crate::interpreted::{Clause, ExprInst};
use crate::interpreter::HandlerTable;
use crate::systems::codegen::call;
use crate::{define_fn, ConstTree, Interner};
use crate::{ConstTree, Interner};
#[derive(Debug, Clone)]
pub struct State(Rc<RefCell<ExprInst>>);
@@ -24,10 +24,9 @@ struct SetStateCmd(State);
#[derive(Debug, Clone)]
struct GetStateCmd(State);
define_fn! {
SetState = |x| Ok(init_cps(2, SetStateCmd(x.downcast()?)));
GetState = |x| Ok(init_cps(2, GetStateCmd(x.downcast()?)))
}
fn get_state(s: State) -> XfnResult<Clause> { Ok(init_cps(2, GetStateCmd(s))) }
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();
@@ -63,8 +62,8 @@ pub fn state_lib(i: &Interner) -> ConstTree {
[i.i("state")],
ConstTree::tree([
(i.i("new_state"), const_cps(2, NewStateCmd)),
(i.i("get_state"), ConstTree::xfn(GetState)),
(i.i("set_state"), ConstTree::xfn(SetState)),
(i.i("get_state"), ConstTree::xfn(xfn_1ary(get_state))),
(i.i("set_state"), ConstTree::xfn(xfn_1ary(set_state))),
]),
)
}

121
src/systems/stl/str.rs
View File

@@ -1,84 +1,77 @@
use unicode_segmentation::UnicodeSegmentation;
use crate::foreign::{xfn_1ary, xfn_2ary, xfn_3ary, XfnResult};
use crate::interner::Interner;
use crate::interpreted::Clause;
use crate::representations::OrcString;
use crate::systems::codegen::{orchid_opt, tuple};
use crate::systems::codegen::{opt, tuple};
use crate::systems::RuntimeError;
use crate::utils::iter_find;
use crate::{define_fn, ConstTree, Literal};
use crate::{ConstTree, Literal};
define_fn! {
pub Len = |x| Ok(Literal::Uint(
(*x.downcast::<OrcString>()?)
.graphemes(true)
.count() as u64
).into());
pub fn len(s: OrcString) -> XfnResult<u64> {
Ok(s.graphemes(true).count() as u64)
}
pub Size = |x| Ok(Literal::Uint(
(*x.downcast::<OrcString>()?)
.as_bytes()
.len() as u64
).into());
pub fn size(s: OrcString) -> XfnResult<u64> { Ok(s.as_bytes().len() as u64) }
expr=x in
/// Append a string to another
pub Concatenate { a: OrcString, b: OrcString } => Ok(
Literal::Str((a.get_string() + b.as_str()).into()).into()
);
/// Append a string to another
pub fn concatenate(a: OrcString, b: OrcString) -> XfnResult<String> {
Ok(a.get_string() + b.as_str())
}
pub Slice { s: OrcString, i: u64, len: u64 } => {
let graphs = s.as_str().graphemes(true);
if i == 0 {
let orc_str = graphs.take(len as usize).collect::<String>().into();
Ok(Literal::Str(orc_str).into())
} else {
let mut prefix = graphs.skip(i as usize - 1);
if prefix.next().is_none() {
RuntimeError::fail(
"Character index out of bounds".to_string(),
"indexing string",
)
} else {
let mut count = 0;
let ret = (prefix.take(len as usize))
.map(|x| { count+=1; x })
.collect::<String>().into();
if count == len {
Ok(Literal::Str(ret).into())
} else {
RuntimeError::fail(
"Character index out of bounds".to_string(),
"indexing string"
)
}
}
}
};
pub Find { haystack: OrcString, needle: OrcString } => {
let haystack_graphs = haystack.as_str().graphemes(true);
let found = iter_find(haystack_graphs, needle.as_str().graphemes(true));
Ok(orchid_opt(found.map(|x| Literal::Uint(x as u64).into())))
};
pub Split { s: OrcString, i: u64 } => {
let mut graphs = s.as_str().graphemes(true);
let a = graphs.by_ref().take(i as usize).collect::<String>();
let b = graphs.collect::<String>();
Ok(tuple([a.into(), b.into()]))
pub fn slice(s: OrcString, i: u64, len: u64) -> XfnResult<String> {
let graphs = s.as_str().graphemes(true);
if i == 0 {
return Ok(graphs.take(len as usize).collect::<String>());
}
let mut prefix = graphs.skip(i as usize - 1);
if prefix.next().is_none() {
return Err(RuntimeError::ext(
"Character index out of bounds".to_string(),
"indexing string",
));
}
let mut count = 0;
let ret = (prefix.take(len as usize))
.map(|x| {
count += 1;
x
})
.collect::<String>();
if count == len {
Ok(ret)
} else {
RuntimeError::fail(
"Character index out of bounds".to_string(),
"indexing 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())))
}
pub fn split(s: OrcString, i: u64) -> XfnResult<Clause> {
let mut graphs = s.as_str().graphemes(true);
let a = graphs.by_ref().take(i as usize).collect::<String>();
let b = graphs.collect::<String>();
Ok(tuple([a.into(), b.into()]))
}
pub fn str(i: &Interner) -> ConstTree {
ConstTree::tree([(
i.i("str"),
ConstTree::tree([
(i.i("concat"), ConstTree::xfn(Concatenate)),
(i.i("slice"), ConstTree::xfn(Slice)),
(i.i("find"), ConstTree::xfn(Find)),
(i.i("split"), ConstTree::xfn(Split)),
(i.i("len"), ConstTree::xfn(Len)),
(i.i("size"), ConstTree::xfn(Size)),
(i.i("concat"), ConstTree::xfn(xfn_2ary(concatenate))),
(i.i("slice"), ConstTree::xfn(xfn_3ary(slice))),
(i.i("find"), ConstTree::xfn(xfn_2ary(find))),
(i.i("split"), ConstTree::xfn(xfn_2ary(split))),
(i.i("len"), ConstTree::xfn(xfn_1ary(len))),
(i.i("size"), ConstTree::xfn(xfn_1ary(size))),
]),
)])
}