From ba0b155ebd98624d5a465b8ae41e5afe3b497f04 Mon Sep 17 00:00:00 2001 From: Lawrence Bethlenfalvy Date: Fri, 22 Sep 2023 23:17:54 +0100 Subject: [PATCH] Removed foreign macros Converted the function integration to use template metaprogramming instead of macros. --- examples/file-browser/main.orc | 41 +++--- src/bin/orcx.rs | 1 + src/error/mod.rs | 2 +- src/facade/process.rs | 47 ++++-- src/foreign/cps_box.rs | 2 +- src/foreign/extern_fn.rs | 6 +- src/foreign/fn_bridge.rs | 199 +++++++++++++++++++++++++ src/foreign/inert.rs | 2 +- src/foreign/mod.rs | 12 +- src/foreign_macros/atomic_impl.rs | 121 --------------- src/foreign_macros/atomic_redirect.rs | 20 --- src/foreign_macros/define_fn.rs | 203 -------------------------- src/foreign_macros/externfn_impl.rs | 45 ------ src/foreign_macros/mod.rs | 5 - src/foreign_macros/write_fn_step.rs | 162 -------------------- src/interpreter/context.rs | 24 +++ src/interpreter/mod.rs | 2 +- src/lib.rs | 1 - src/pipeline/mod.rs | 2 +- src/representations/ast.rs | 2 +- src/representations/interpreted.rs | 26 ++++ src/representations/path_set.rs | 23 +++ src/systems/assertion_error.rs | 2 +- src/systems/asynch/async.orc | 2 + src/systems/asynch/system.rs | 20 ++- src/systems/cast_exprinst.rs | 6 +- src/systems/codegen.rs | 50 +++---- src/systems/directfs/commands.rs | 146 +++++++++--------- src/systems/directfs/mod.rs | 1 + src/systems/directfs/osstring.rs | 28 ++++ src/systems/io/bindings.rs | 103 ++++++------- src/systems/io/mod.rs | 2 +- src/systems/scheduler/system.rs | 28 ++-- src/systems/stl/bin.rs | 203 +++++++++++++------------- src/systems/stl/bool.rs | 52 +++---- src/systems/stl/conv.rs | 63 ++++---- src/systems/stl/inspect.rs | 32 ++-- src/systems/stl/list.orc | 4 +- src/systems/stl/map.orc | 2 +- src/systems/stl/num.rs | 113 +++++++------- src/systems/stl/panic.rs | 17 +-- src/systems/stl/proc.orc | 10 +- src/systems/stl/result.orc | 10 ++ src/systems/stl/state.rs | 17 +-- src/systems/stl/str.rs | 121 ++++++++------- 45 files changed, 854 insertions(+), 1126 deletions(-) create mode 100644 src/foreign/fn_bridge.rs delete mode 100644 src/foreign_macros/atomic_impl.rs delete mode 100644 src/foreign_macros/atomic_redirect.rs delete mode 100644 src/foreign_macros/define_fn.rs delete mode 100644 src/foreign_macros/externfn_impl.rs delete mode 100644 src/foreign_macros/mod.rs delete mode 100644 src/foreign_macros/write_fn_step.rs create mode 100644 src/systems/directfs/osstring.rs create mode 100644 src/systems/stl/result.orc diff --git a/examples/file-browser/main.orc b/examples/file-browser/main.orc index b1992f3..de32968 100644 --- a/examples/file-browser/main.orc +++ b/examples/file-browser/main.orc @@ -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; } diff --git a/src/bin/orcx.rs b/src/bin/orcx.rs index f7b36b0..ad71eb3 100644 --- a/src/bin/orcx.rs +++ b/src/bin/orcx.rs @@ -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; diff --git a/src/error/mod.rs b/src/error/mod.rs index b02e415..f98c3b5 100644 --- a/src/error/mod.rs +++ b/src/error/mod.rs @@ -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; diff --git a/src/facade/process.rs b/src/facade/process.rs index 5a0644a..56f3b9a 100644 --- a/src/facade/process.rs +++ b/src/facade/process.rs @@ -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, +} +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 { + Box::new( + (self.errors.clone().into_iter()) + .map(|i| ErrorPosition { location: i.location, message: None }), + ) + } } diff --git a/src/foreign/cps_box.rs b/src/foreign/cps_box.rs index 90e4f3d..b553ba7 100644 --- a/src/foreign/cps_box.rs +++ b/src/foreign/cps_box.rs @@ -36,7 +36,7 @@ impl CPSFn { } impl ExternFn for CPSFn { fn name(&self) -> &str { "CPS function without argument" } - fn apply(self: Box, arg: ExprInst, _ctx: Context) -> XfnResult { + fn apply(self: Box, arg: ExprInst, _ctx: Context) -> XfnResult { let payload = self.payload.clone(); let continuations = pushed_ref(&self.continuations, arg); if self.argc == 1 { diff --git a/src/foreign/extern_fn.rs b/src/foreign/extern_fn.rs index 41972bd..e1622b2 100644 --- a/src/foreign/extern_fn.rs +++ b/src/foreign/extern_fn.rs @@ -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>; - /// 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, arg: ExprInst, ctx: Context) -> XfnResult; + fn apply(self: Box, arg: ExprInst, ctx: Context) -> XfnResult; /// Hash the name to get a somewhat unique hash. fn hash(&self, mut state: &mut dyn std::hash::Hasher) { self.name().hash(&mut state) diff --git a/src/foreign/fn_bridge.rs b/src/foreign/fn_bridge.rs new file mode 100644 index 0000000..c80fc63 --- /dev/null +++ b/src/foreign/fn_bridge.rs @@ -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 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 ToClause for Option { + fn to_clause(self) -> Clause { opt(self.map(|t| t.to_clause().wrap())) } +} +impl ToClause for Result { + 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 { + data: F, + _t: PhantomData, + _u: PhantomData, +} +impl Param { + /// Wrap a new function in a parametric struct + pub fn new(f: F) -> Self + where + F: FnOnce(T) -> Result>, + { + Self { data: f, _t: PhantomData::default(), _u: PhantomData::default() } + } + /// Take out the function + pub fn get(self) -> F { self.data } +} +impl Clone for Param { + 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>, +> ToClause for Param +{ + fn to_clause(self) -> Clause { self.xfn_cls() } +} + +struct FnMiddleStage { + argument: ExprInst, + f: Param, +} + +impl Clone for FnMiddleStage { + fn clone(&self) -> Self { + Self { argument: self.argument.clone(), f: self.f.clone() } + } +} +impl Debug for FnMiddleStage { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + f.debug_struct("FnMiddleStage") + .field("argument", &self.argument) + .finish_non_exhaustive() + } +} +impl Responder for FnMiddleStage {} +impl< + T: 'static + TryFromExprInst, + U: 'static + ToClause, + F: 'static + Clone + FnOnce(T) -> Result>, +> Atomic for FnMiddleStage +{ + fn as_any(self: Box) -> Box { self } + fn as_any_ref(&self) -> &dyn std::any::Any { self } + fn run(self: Box, 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>, +> ExternFn for Param +{ + fn name(&self) -> &str { "anonymous Rust function" } + fn apply(self: Box, arg: ExprInst, _: Context) -> XfnResult { + 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> + 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 +} diff --git a/src/foreign/inert.rs b/src/foreign/inert.rs index 07e90e3..b1b677f 100644 --- a/src/foreign/inert.rs +++ b/src/foreign/inert.rs @@ -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; diff --git a/src/foreign/mod.rs b/src/foreign/mod.rs index f474a6e..2cb8ecd 100644 --- a/src/foreign/mod.rs +++ b/src/foreign/mod.rs @@ -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; +/// Return type of the argument to the [xfn_1ary] family of functions +pub type XfnResult = Result>; diff --git a/src/foreign_macros/atomic_impl.rs b/src/foreign_macros/atomic_impl.rs deleted file mode 100644 index c116f77..0000000 --- a/src/foreign_macros/atomic_impl.rs +++ /dev/null @@ -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`] 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) -> Box { self } - fn as_any_ref(&self) -> &dyn std::any::Any { self } - - fn run( - self: Box, - ctx: $crate::interpreter::Context, - ) -> $crate::foreign::AtomicResult { - // extract the expression - let mut this = *self; - let expr = - >::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, - > = 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 }) - } - } - }; -} diff --git a/src/foreign_macros/atomic_redirect.rs b/src/foreign_macros/atomic_redirect.rs deleted file mode 100644 index 2ae4bd2..0000000 --- a/src/foreign_macros/atomic_redirect.rs +++ /dev/null @@ -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 - } - } - }; -} diff --git a/src/foreign_macros/define_fn.rs b/src/foreign_macros/define_fn.rs deleted file mode 100644 index bf6e424..0000000 --- a/src/foreign_macros/define_fn.rs +++ /dev/null @@ -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`. -/// -/// 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 - ); - }; -} diff --git a/src/foreign_macros/externfn_impl.rs b/src/foreign_macros/externfn_impl.rs deleted file mode 100644 index e14fb22..0000000 --- a/src/foreign_macros/externfn_impl.rs +++ /dev/null @@ -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, - 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), - } - } - } - }; -} diff --git a/src/foreign_macros/mod.rs b/src/foreign_macros/mod.rs deleted file mode 100644 index dcf77be..0000000 --- a/src/foreign_macros/mod.rs +++ /dev/null @@ -1,5 +0,0 @@ -mod atomic_impl; -mod atomic_redirect; -mod define_fn; -mod externfn_impl; -mod write_fn_step; diff --git a/src/foreign_macros/write_fn_step.rs b/src/foreign_macros/write_fn_step.rs deleted file mode 100644 index 628c7c7..0000000 --- a/src/foreign_macros/write_fn_step.rs +++ /dev/null @@ -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::(); -/// ); -/// // Exit state -/// write_fn_step!( -/// CharAt0 { s: OrcString } -/// i = x => x.downcast::(); -/// { -/// 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>`. 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()? - }; -} diff --git a/src/interpreter/context.rs b/src/interpreter/context.rs index b5f95d7..caf4c4e 100644 --- a/src/interpreter/context.rs +++ b/src/interpreter/context.rs @@ -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, +} diff --git a/src/interpreter/mod.rs b/src/interpreter/mod.rs index 988f945..b2dbedc 100644 --- a/src/interpreter/mod.rs +++ b/src/interpreter/mod.rs @@ -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; diff --git a/src/lib.rs b/src/lib.rs index e0688ad..c06e498 100644 --- a/src/lib.rs +++ b/src/lib.rs @@ -10,7 +10,6 @@ pub mod error; pub mod facade; pub mod foreign; -mod foreign_macros; pub mod interner; pub mod interpreter; mod parse; diff --git a/src/pipeline/mod.rs b/src/pipeline/mod.rs index d74c6c4..bca79a4 100644 --- a/src/pipeline/mod.rs +++ b/src/pipeline/mod.rs @@ -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; diff --git a/src/representations/ast.rs b/src/representations/ast.rs index 5d3a539..f22c212 100644 --- a/src/representations/ast.rs +++ b/src/representations/ast.rs @@ -179,7 +179,7 @@ impl Clause { Some(Self::S('(', Rc::new(exprs.to_vec()))) } } - + /// Convert with identical meaning #[must_use] pub fn from_exprv(exprv: &Rc>>) -> Option> { diff --git a/src/representations/interpreted.rs b/src/representations/interpreted.rs index f4b8fc1..bebe36f 100644 --- a/src/representations/interpreted.rs +++ b/src/representations/interpreted.rs @@ -57,6 +57,10 @@ pub trait TryFromExprInst: Sized { fn from_exi(exi: ExprInst) -> Result>; } +impl TryFromExprInst for ExprInst { + fn from_exi(exi: ExprInst) -> Result> { 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 { diff --git a/src/representations/path_set.rs b/src/representations/path_set.rs index dca7bb4..086ac85 100644 --- a/src/representations/path_set.rs +++ b/src/representations/path_set.rs @@ -15,6 +15,29 @@ pub struct PathSet { pub next: Option<(Rc, Rc)>, } +impl PathSet { + /// Create a path set for more than one target + pub fn branch( + steps: impl IntoIterator, + 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) -> 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() { diff --git a/src/systems/assertion_error.rs b/src/systems/assertion_error.rs index 5086966..7a50ef0 100644 --- a/src/systems/assertion_error.rs +++ b/src/systems/assertion_error.rs @@ -19,7 +19,7 @@ impl AssertionError { location: Location, message: &'static str, ) -> Result> { - return Err(Self { location, message }.into_extern()); + return Err(Self::ext(location, message)); } /// Construct and upcast to [ExternError] diff --git a/src/systems/asynch/async.orc b/src/systems/asynch/async.orc index 737b59a..52d9f54 100644 --- a/src/systems/asynch/async.orc +++ b/src/systems/asynch/async.orc @@ -1,3 +1,5 @@ +import std::panic + export const block_on := \action.\cont. ( action cont (\e.panic "unwrapped asynch call") diff --git a/src/systems/asynch/system.rs b/src/systems/asynch/system.rs index b27978c..fa70175 100644 --- a/src/systems/asynch/system.rs +++ b/src/systems/asynch/system.rs @@ -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, + delay: NotNan, } -define_fn! {expr=x in - SetTimer { - recurring: Boolean, - duration: NotNan - } => Ok(init_cps(2, Timer{ recurring, duration })) + +pub fn set_timer(recurring: Boolean, delay: NotNan) -> XfnResult { + Ok(init_cps(2, Timer { recurring, delay })) } #[derive(Clone)] @@ -135,7 +133,7 @@ impl<'a> IntoSystem<'a> for AsynchSystem<'a> { move |t: Box>| { 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)), ]), ) diff --git a/src/systems/cast_exprinst.rs b/src/systems/cast_exprinst.rs index 99adba7..716b014 100644 --- a/src/systems/cast_exprinst.rs +++ b/src/systems/cast_exprinst.rs @@ -15,8 +15,10 @@ use crate::{Location, Primitive}; pub fn get_literal( exi: ExprInst, ) -> Result<(Literal, Location), Rc> { - (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 ######## diff --git a/src/systems/codegen.rs b/src/systems/codegen.rs index c5575f1..9ab9e7a 100644 --- a/src/systems/codegen.rs +++ b/src/systems/codegen.rs @@ -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) -> 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) -> 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) -> 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) -> 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) -> Clause { /// Build an Orchid list from a Rust iterator pub fn list(items: impl IntoIterator) -> 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())) } diff --git a/src/systems/directfs/commands.rs b/src/systems/directfs/commands.rs index 669baa3..af2f63b 100644 --- a/src/systems/directfs/commands.rs +++ b/src/systems/directfs/commands.rs @@ -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) -> Box { self } + fn as_any_ref(&self) -> &dyn std::any::Any { self } + fn run( + self: Box, + 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) -> 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)); - vec![call(succ, [source.atom_exi()]).wrap()] + let source: Source = + BufReader::new(Box::new(f) as Box); + vec![call(succ, [SharedHandle::wrap(source).atom_exi()]).wrap()] }, }, ); @@ -61,7 +84,6 @@ fn read_file(sched: &SeqScheduler, cmd: CPSBox) -> ExprInst { #[must_use] fn read_dir(sched: &SeqScheduler, cmd: CPSBox) -> 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) -> 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::, Clause>>(); match converted { Err(e) => vec![call(fail, [e.wrap()]).wrap()], @@ -90,7 +110,6 @@ fn read_dir(sched: &SeqScheduler, cmd: CPSBox) -> ExprInst { #[must_use] pub fn write_file(sched: &SeqScheduler, cmd: CPSBox) -> 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) -> 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 { + Ok(init_cps(3, ReadFileCmd(name))) } -fn os_str_cls(str: OsString) -> Result { - (str.into_string()) - .map_err(|e| InvalidString(e).atom_cls()) - .map(|s| OrcString::from(s).cls()) +pub fn read_dir_cmd(name: OsString) -> XfnResult { + Ok(init_cps(3, ReadDirCmd(name))) } -define_fn! { - pub IsInvalidString = |x| { - Ok(Boolean(x.downcast::().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 { + 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::()?; - 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::, _>>()? - ).wrap()))) - } +pub fn open_file_append_cmd(name: OsString) -> XfnResult { + Ok(init_cps(3, WriteFile { name, append: true })) +} + +pub fn join_paths(root: OsString, sub: OsString) -> XfnResult { + let mut path = PathBuf::from(root); + path.push(sub); + Ok(path.into_os_string()) +} + +pub fn pop_path(path: OsString) -> XfnResult { + 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, diff --git a/src/systems/directfs/mod.rs b/src/systems/directfs/mod.rs index dd33cae..6cfa9aa 100644 --- a/src/systems/directfs/mod.rs +++ b/src/systems/directfs/mod.rs @@ -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; diff --git a/src/systems/directfs/osstring.rs b/src/systems/directfs/osstring.rs new file mode 100644 index 0000000..4267c33 --- /dev/null +++ b/src/systems/directfs/osstring.rs @@ -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> { + Ok(os.into_string()) +} + +pub fn string_to_os(str: OrcString) -> XfnResult { + Ok(str.get_string().into()) +} + +pub fn os_print(os: OsString) -> XfnResult { + 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))), + ]) +} diff --git a/src/systems/io/bindings.rs b/src/systems/io/bindings.rs index ce290a4..2c56562 100644 --- a/src/systems/io/bindings.rs +++ b/src/systems/io/bindings.rs @@ -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, n: u64 } => { - Ok(init_cps(3, IOCmdHandlePack{ - cmd: ReadCmd::RBytes(BRead::N(n.try_into().unwrap())), - handle: stream.clone() - })) - }; - ReadUntil { stream: SharedHandle, 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, string: OrcString } => { - Ok(init_cps(3, IOCmdHandlePack { - cmd: WriteCmd::WStr(string.get_string()), - handle: stream.clone(), - })) - }; - WriteBin { stream: SharedHandle, 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; +type ReadHandle = SharedHandle; + +pub fn read_string(handle: ReadHandle) -> XfnResult { + Ok(init_cps(3, IOCmdHandlePack { handle, cmd: ReadCmd::RStr(SRead::All) })) +} +pub fn read_line(handle: ReadHandle) -> XfnResult { + Ok(init_cps(3, IOCmdHandlePack { handle, cmd: ReadCmd::RStr(SRead::Line) })) +} +pub fn read_bin(handle: ReadHandle) -> XfnResult { + Ok(init_cps(3, IOCmdHandlePack { handle, cmd: ReadCmd::RBytes(BRead::All) })) +} +pub fn read_bytes(handle: ReadHandle, n: u64) -> XfnResult { + 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 { + 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 { + let cmd = WriteCmd::WStr(string.get_string()); + Ok(init_cps(3, IOCmdHandlePack { handle, cmd })) +} +pub fn write_bin(handle: WriteHandle, bytes: Binary) -> XfnResult { + Ok(init_cps(3, IOCmdHandlePack { handle, cmd: WriteCmd::WBytes(bytes) })) +} +pub fn flush(handle: WriteHandle) -> XfnResult { + 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() diff --git a/src/systems/io/mod.rs b/src/systems/io/mod.rs index 744604e..9bda352 100644 --- a/src/systems/io/mod.rs +++ b/src/systems/io/mod.rs @@ -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}; diff --git a/src/systems/scheduler/system.rs b/src/systems/scheduler/system.rs index fe3afea..0e071d2 100644 --- a/src/systems/scheduler/system.rs +++ b/src/systems/scheduler/system.rs @@ -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 { 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::(1, t)), - None => AssertionError::fail(location, "SharedHandle"), - } - }; - IsTakenError = |x| { - Ok(Boolean(x.downcast::().is_ok()).atom_cls()) +pub fn take_and_drop(x: ExprInst) -> XfnResult { + match x.request() { + Some(t) => Ok(init_cps::(1, t)), + None => AssertionError::fail(Location::Unknown, "SharedHandle"), } } +pub fn is_taken_error(x: ExprInst) -> XfnResult { + Ok(Boolean(x.downcast::().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(), diff --git a/src/systems/stl/bin.rs b/src/systems/stl/bin.rs index 5142d6e..03decd5 100644 --- a/src/systems/stl/bin.rs +++ b/src/systems/stl/bin.rs @@ -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::()?.0.len() as u64).into()) - }; +/// Append two binary data blocks +pub fn concatenate(a: Binary, b: Binary) -> XfnResult { + 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 { + 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 { + 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 { + 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 { + 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 { + 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 { + 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))), ]), )]) } diff --git a/src/systems/stl/bool.rs b/src/systems/stl/bool.rs index 98e6e3d..d287146 100644 --- a/src/systems/stl/bool.rs +++ b/src/systems/stl/bool.rs @@ -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 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 { + 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 { + 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))), ]), diff --git a/src/systems/stl/conv.rs b/src/systems/stl/conv.rs index cf33e57..c206a44 100644 --- a/src/systems/stl/conv.rs +++ b/src/systems/stl/conv.rs @@ -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 { + 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 { + 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 { + 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))), ]) } diff --git a/src/systems/stl/inspect.rs b/src/systems/stl/inspect.rs index 6fdf7ab..38a3581 100644 --- a/src/systems/stl/inspect.rs +++ b/src/systems/stl/inspect.rs @@ -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) -> Box { self } - fn as_any_ref(&self) -> &dyn std::any::Any { self } - fn run(self: Box, 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, arg: ExprInst, _: Context) -> XfnResult { + println!("{arg}"); + Ok(arg.expr().clause.clone()) } } diff --git a/src/systems/stl/list.orc b/src/systems/stl/list.orc index a3dfb6c..f6ed9e5 100644 --- a/src/systems/stl/list.orc +++ b/src/systems/stl/list.orc @@ -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 ) diff --git a/src/systems/stl/map.orc b/src/systems/stl/map.orc index b4d2c50..4570865 100644 --- a/src/systems/stl/map.orc +++ b/src/systems/stl/map.orc @@ -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) ) diff --git a/src/systems/stl/num.rs b/src/systems/stl/num.rs index 969d62e..bbac9b8 100644 --- a/src/systems/stl/num.rs +++ b/src/systems/stl/num.rs @@ -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 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 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 { + 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 { + 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 { + 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 { + 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 { + 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))), ]), )]) } diff --git a/src/systems/stl/panic.rs b/src/systems/stl/panic.rs index afc9cf3..485da56 100644 --- a/src/systems/stl/panic.rs +++ b/src/systems/stl/panic.rs @@ -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::()?.get_string()); - Err(OrchidPanic(msg).into_extern()) - } +/// Takes a message, returns an [ExternError] unconditionally. +pub fn orc_panic(msg: OrcString) -> XfnResult { + // 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)))]) } diff --git a/src/systems/stl/proc.orc b/src/systems/stl/proc.orc index f79bcdf..0c6ff4c 100644 --- a/src/systems/stl/proc.orc +++ b/src/systems/stl/proc.orc @@ -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) ) diff --git a/src/systems/stl/result.orc b/src/systems/stl/result.orc new file mode 100644 index 0000000..4b26ed0 --- /dev/null +++ b/src/systems/stl/result.orc @@ -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 diff --git a/src/systems/stl/state.rs b/src/systems/stl/state.rs index 759392b..bbe5c52 100644 --- a/src/systems/stl/state.rs +++ b/src/systems/stl/state.rs @@ -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>); @@ -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 { Ok(init_cps(2, GetStateCmd(s))) } + +fn set_state(s: State) -> XfnResult { Ok(init_cps(2, SetStateCmd(s))) } fn new_state_handler(cmd: CPSBox) -> Result { 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))), ]), ) } diff --git a/src/systems/stl/str.rs b/src/systems/stl/str.rs index 540be20..4da708b 100644 --- a/src/systems/stl/str.rs +++ b/src/systems/stl/str.rs @@ -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::()?) - .graphemes(true) - .count() as u64 - ).into()); +pub fn len(s: OrcString) -> XfnResult { + Ok(s.graphemes(true).count() as u64) +} - pub Size = |x| Ok(Literal::Uint( - (*x.downcast::()?) - .as_bytes() - .len() as u64 - ).into()); +pub fn size(s: OrcString) -> XfnResult { 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 { + 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::().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::().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::(); - let b = graphs.collect::(); - Ok(tuple([a.into(), b.into()])) +pub fn slice(s: OrcString, i: u64, len: u64) -> XfnResult { + let graphs = s.as_str().graphemes(true); + if i == 0 { + return Ok(graphs.take(len as usize).collect::()); } + 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::(); + 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 { + 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 { + let mut graphs = s.as_str().graphemes(true); + let a = graphs.by_ref().take(i as usize).collect::(); + let b = graphs.collect::(); + 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))), ]), )]) }