diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,81 @@ # Revision history for zeolite-lang +## 0.15.0.0 -- 2021-03-24 + +### Language + +* **[breaking]** Splits `Builder<#x>` built-in into `Append<#x|>` and + `Build<|#x>` to more accurately reflect its semantics. + +* **[breaking]** Splits `ReadPosition<#x>` built-in into `ReadAt<|#x>`, + `SubSequence`, and `Container` to be more concise, and to split up reading + from subsequencing. This also includes renaming `readSize()` to just `size()`. + +* **[new]** Adds the `Default` `@type interface`, to specify a default `@value` + for the type. + +* **[fix]** Fixes merging of duplicate inherited categories. Previously, if a + category `Foo` was indirectly inherited multiple times then the compiler + would complain about having multiple functions with the same name. + +* **[fix]** Adds support for `^` with the `Bool` built-in type. + +### Libraries + +* **[breaking]** Refactors iterators in `lib/util`: + + * **[breaking]** Makes `ReadIterator` a `@value interface`. + + * **[breaking]** Adds `AutoReadIterator`, `AutoWriteIterator`, and + `AutoIterator` helpers to create iterators from `ReadAt` and `WriteAt`. + (`AutoReadIterator` replaces the previous `ReadIterator`.) + + * **[new]** Adds `WriteAt`, `WriteCurrent`, `WriteIterator`, and `Iterator` + `@value interface`s. + +* **[new]** Adds `lib/container`: + + * **[new]** `Vector`, a random-access container. + + * **[new]** `SearchTree`, a binary search tree. + + * **[new]** `TypeMap`, a heterogeneous key-value map of different value types. + + * **[new]** Various `@value interface`s with container usage patterns. + +* **[new]** Adds `lib/thread` (must be built manually): + + * **[new]** `ProcessThread`, a basic thread runner. + + * **[new]** `SimpleMutex` and `MutexLock`, for basic mutex logic. + + * **[new]** Various `@value interface`s with thread usage patterns. + +### Compiler CLI + +* **[breaking]** Removes implicit dependence of C++ extensions on built-in + categories `Bool`, `Float`, `Char`, `Int`, `String`, and `Formatted`. + Extensions that use these categories *without* using them in the corresponding + `concrete` declaration will need to add them to the `requires:` field of the + `category_source` in `.zeolite-module`. + + ```text + category_source { + source: "Extension_MyType.cpp" + categories: [MyType] + requires: [String,Formatted] + } + ``` + +* **[breaking]** Cleans up `TypeInstance` caching for C++ extensions with + parameters. See `lib/container/src/Extension_Vector.cpp` for an example of the + new semantics, or use `--templates` to create a new template. + +### Examples + +* Removes `example/tree`. All of the corresponding code has been moved into + `lib/container`. + ## 0.14.0.0 -- 2021-03-19 ### Language @@ -21,12 +97,6 @@ ### Language -* **[breaking]** Streamlines C++ extensions to cut down on boilerplate code. - This is a massive change that breaks *all* existing C++ extensions; however, - hand-written procedure definitions can be copied-and-pasted into a new - extension template. Use `zeolite --templates` to regenerate new templates for - C++ extensions. - * **[new]** Adds pragmas for local variable rules: * **[new]** `$ReadOnly[foo]$` marks `foo` as read-only in the current context @@ -41,6 +111,12 @@ checks, but `reduce` was missed. ### Compiler CLI + +* **[breaking]** Streamlines C++ extensions to cut down on boilerplate code. + This is a massive change that breaks *all* existing C++ extensions; however, + hand-written procedure definitions can be copied-and-pasted into a new + extension template. Use `zeolite --templates` to regenerate new templates for + C++ extensions. * **[breaking]** Adds [`microlens`][microlens] and [`microlens-th`][microlens-th] as dependencies, to help clean up the compiler diff --git a/base/Category_Bool.cpp b/base/Category_Bool.cpp --- a/base/Category_Bool.cpp +++ b/base/Category_Bool.cpp @@ -26,6 +26,7 @@ #include "Category_AsInt.hpp" #include "Category_AsFloat.hpp" #include "Category_Formatted.hpp" +#include "Category_Default.hpp" #include "Category_Equals.hpp" @@ -102,9 +103,18 @@ ReturnTuple Dispatch(const S& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final { using CallType = ReturnTuple(Type_Bool::*)(const ParamTuple&, const ValueTuple&); + static const CallType Table_Default[] = { + &Type_Bool::Call_default, + }; static const CallType Table_Equals[] = { &Type_Bool::Call_equals, }; + if (label.collection == Functions_Default) { + if (label.function_num < 0 || label.function_num >= 1) { + FAIL() << "Bad function call " << label; + } + return (this->*Table_Default[label.function_num])(params, args); + } if (label.collection == Functions_Equals) { if (label.function_num < 0 || label.function_num >= 1) { FAIL() << "Bad function call " << label; @@ -113,6 +123,7 @@ } return TypeInstance::Dispatch(self, label, params, args); } + ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_equals(const ParamTuple& params, const ValueTuple& args); }; S CreateType_Bool(Params<0>::Type params) { @@ -170,6 +181,11 @@ const S parent; const bool value_; }; + +ReturnTuple Type_Bool::Call_default(const ParamTuple& params, const ValueTuple& args) { + TRACE_FUNCTION("Bool.default") + return ReturnTuple(Box_Bool(false)); +} ReturnTuple Type_Bool::Call_equals(const ParamTuple& params, const ValueTuple& args) { TRACE_FUNCTION("Bool.equals") const bool Var_arg1 = (args.At(0))->AsBool(); diff --git a/base/Category_Char.cpp b/base/Category_Char.cpp --- a/base/Category_Char.cpp +++ b/base/Category_Char.cpp @@ -27,6 +27,7 @@ #include "Category_AsInt.hpp" #include "Category_AsFloat.hpp" #include "Category_Formatted.hpp" +#include "Category_Default.hpp" #include "Category_Equals.hpp" #include "Category_LessThan.hpp" @@ -108,12 +109,21 @@ ReturnTuple Dispatch(const S& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final { using CallType = ReturnTuple(Type_Char::*)(const ParamTuple&, const ValueTuple&); + static const CallType Table_Default[] = { + &Type_Char::Call_default, + }; static const CallType Table_Equals[] = { &Type_Char::Call_equals, }; static const CallType Table_LessThan[] = { &Type_Char::Call_lessThan, }; + if (label.collection == Functions_Default) { + if (label.function_num < 0 || label.function_num >= 1) { + FAIL() << "Bad function call " << label; + } + return (this->*Table_Default[label.function_num])(params, args); + } if (label.collection == Functions_Equals) { if (label.function_num < 0 || label.function_num >= 1) { FAIL() << "Bad function call " << label; @@ -128,6 +138,7 @@ } return TypeInstance::Dispatch(self, label, params, args); } + ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_equals(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_lessThan(const ParamTuple& params, const ValueTuple& args); }; @@ -196,6 +207,11 @@ const S parent; const PrimChar value_; }; + +ReturnTuple Type_Char::Call_default(const ParamTuple& params, const ValueTuple& args) { + TRACE_FUNCTION("Char.default") + return ReturnTuple(Box_Char('\0')); +} ReturnTuple Type_Char::Call_equals(const ParamTuple& params, const ValueTuple& args) { TRACE_FUNCTION("Char.equals") const PrimChar Var_arg1 = (args.At(0))->AsChar(); diff --git a/base/Category_Float.cpp b/base/Category_Float.cpp --- a/base/Category_Float.cpp +++ b/base/Category_Float.cpp @@ -26,6 +26,7 @@ #include "Category_AsInt.hpp" #include "Category_AsFloat.hpp" #include "Category_Formatted.hpp" +#include "Category_Default.hpp" #include "Category_Equals.hpp" #include "Category_LessThan.hpp" @@ -103,12 +104,21 @@ ReturnTuple Dispatch(const S& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final { using CallType = ReturnTuple(Type_Float::*)(const ParamTuple&, const ValueTuple&); + static const CallType Table_Default[] = { + &Type_Float::Call_default, + }; static const CallType Table_Equals[] = { &Type_Float::Call_equals, }; static const CallType Table_LessThan[] = { &Type_Float::Call_lessThan, }; + if (label.collection == Functions_Default) { + if (label.function_num < 0 || label.function_num >= 1) { + FAIL() << "Bad function call " << label; + } + return (this->*Table_Default[label.function_num])(params, args); + } if (label.collection == Functions_Equals) { if (label.function_num < 0 || label.function_num >= 1) { FAIL() << "Bad function call " << label; @@ -123,6 +133,7 @@ } return TypeInstance::Dispatch(self, label, params, args); } + ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_equals(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_lessThan(const ParamTuple& params, const ValueTuple& args); }; @@ -181,6 +192,11 @@ const S parent; const PrimFloat value_; }; + +ReturnTuple Type_Float::Call_default(const ParamTuple& params, const ValueTuple& args) { + TRACE_FUNCTION("Float.default") + return ReturnTuple(Box_Float(0.0)); +} ReturnTuple Type_Float::Call_equals(const ParamTuple& params, const ValueTuple& args) { TRACE_FUNCTION("Float.equals") const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); diff --git a/base/Category_Int.cpp b/base/Category_Int.cpp --- a/base/Category_Int.cpp +++ b/base/Category_Int.cpp @@ -27,6 +27,7 @@ #include "Category_AsInt.hpp" #include "Category_AsFloat.hpp" #include "Category_Formatted.hpp" +#include "Category_Default.hpp" #include "Category_Equals.hpp" #include "Category_LessThan.hpp" @@ -108,12 +109,21 @@ ReturnTuple Dispatch(const S& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final { using CallType = ReturnTuple(Type_Int::*)(const ParamTuple&, const ValueTuple&); + static const CallType Table_Default[] = { + &Type_Int::Call_default, + }; static const CallType Table_Equals[] = { &Type_Int::Call_equals, }; static const CallType Table_LessThan[] = { &Type_Int::Call_lessThan, }; + if (label.collection == Functions_Default) { + if (label.function_num < 0 || label.function_num >= 1) { + FAIL() << "Bad function call " << label; + } + return (this->*Table_Default[label.function_num])(params, args); + } if (label.collection == Functions_Equals) { if (label.function_num < 0 || label.function_num >= 1) { FAIL() << "Bad function call " << label; @@ -128,6 +138,7 @@ } return TypeInstance::Dispatch(self, label, params, args); } + ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_equals(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_lessThan(const ParamTuple& params, const ValueTuple& args); }; @@ -196,6 +207,11 @@ const S parent; const PrimInt value_; }; + +ReturnTuple Type_Int::Call_default(const ParamTuple& params, const ValueTuple& args) { + TRACE_FUNCTION("Int.default") + return ReturnTuple(Box_Int(0)); +} ReturnTuple Type_Int::Call_equals(const ParamTuple& params, const ValueTuple& args) { TRACE_FUNCTION("Int.equals") const PrimInt Var_arg1 = (args.At(0))->AsInt(); diff --git a/base/Category_String.cpp b/base/Category_String.cpp --- a/base/Category_String.cpp +++ b/base/Category_String.cpp @@ -24,11 +24,15 @@ #include "category-source.hpp" #include "Category_AsBool.hpp" #include "Category_Formatted.hpp" -#include "Category_ReadPosition.hpp" #include "Category_Char.hpp" +#include "Category_Container.hpp" +#include "Category_ReadAt.hpp" +#include "Category_SubSequence.hpp" +#include "Category_Append.hpp" +#include "Category_Build.hpp" +#include "Category_Default.hpp" #include "Category_Equals.hpp" #include "Category_LessThan.hpp" -#include "Category_Builder.hpp" #ifdef ZEOLITE_PUBLIC_NAMESPACE @@ -88,7 +92,7 @@ args = std::vector>{}; return true; } - if (&category == &GetCategory_ReadPosition()) { + if (&category == &GetCategory_ReadAt()) { args = std::vector>{GetType_Char(T_get())}; return true; } @@ -102,6 +106,9 @@ ReturnTuple Dispatch(const S& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final { using CallType = ReturnTuple(Type_String::*)(const ParamTuple&, const ValueTuple&); + static const CallType Table_Default[] = { + &Type_String::Call_default, + }; static const CallType Table_Equals[] = { &Type_String::Call_equals, }; @@ -111,6 +118,12 @@ static const CallType Table_String[] = { &Type_String::Call_builder, }; + if (label.collection == Functions_Default) { + if (label.function_num < 0 || label.function_num >= 1) { + FAIL() << "Bad function call " << label; + } + return (this->*Table_Default[label.function_num])(params, args); + } if (label.collection == Functions_Equals) { if (label.function_num < 0 || label.function_num >= 1) { FAIL() << "Bad function call " << label; @@ -131,6 +144,7 @@ } return TypeInstance::Dispatch(self, label, params, args); } + ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_builder(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_equals(const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_lessThan(const ParamTuple& params, const ValueTuple& args); @@ -149,14 +163,18 @@ static const CallType Table_Formatted[] = { &Value_String::Call_formatted, }; - static const CallType Table_ReadPosition[] = { - &Value_String::Call_readPosition, - &Value_String::Call_readSize, - &Value_String::Call_subSequence, + static const CallType Table_ReadAt[] = { + &Value_String::Call_readAt, }; + static const CallType Table_Container[] = { + &Value_String::Call_size, + }; static const CallType Table_String[] = { &Value_String::Call_subSequence, }; + static const CallType Table_SubSequence[] = { + &Value_String::Call_subSequence, + }; if (label.collection == Functions_AsBool) { if (label.function_num < 0 || label.function_num >= 1) { FAIL() << "Bad function call " << label; @@ -169,26 +187,38 @@ } return (this->*Table_Formatted[label.function_num])(self, params, args); } - if (label.collection == Functions_ReadPosition) { - if (label.function_num < 0 || label.function_num >= 3) { + if (label.collection == Functions_ReadAt) { + if (label.function_num < 0 || label.function_num >= 2) { FAIL() << "Bad function call " << label; } - return (this->*Table_ReadPosition[label.function_num])(self, params, args); + return (this->*Table_ReadAt[label.function_num])(self, params, args); } + if (label.collection == Functions_Container) { + if (label.function_num < 0 || label.function_num >= 2) { + FAIL() << "Bad function call " << label; + } + return (this->*Table_Container[label.function_num])(self, params, args); + } if (label.collection == Functions_String) { if (label.function_num < 0 || label.function_num >= 1) { FAIL() << "Bad function call " << label; } return (this->*Table_String[label.function_num])(self, params, args); } + if (label.collection == Functions_SubSequence) { + if (label.function_num < 0 || label.function_num >= 1) { + FAIL() << "Bad function call " << label; + } + return (this->*Table_SubSequence[label.function_num])(self, params, args); + } return TypeValue::Dispatch(self, label, params, args); } std::string CategoryName() const final { return parent->CategoryName(); } const PrimString& AsString() const final { return value_; } ReturnTuple Call_asBool(const S& Var_self, const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_formatted(const S& Var_self, const ParamTuple& params, const ValueTuple& args); - ReturnTuple Call_readPosition(const S& Var_self, const ParamTuple& params, const ValueTuple& args); - ReturnTuple Call_readSize(const S& Var_self, const ParamTuple& params, const ValueTuple& args); + ReturnTuple Call_readAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args); + ReturnTuple Call_size(const S& Var_self, const ParamTuple& params, const ValueTuple& args); ReturnTuple Call_subSequence(const S& Var_self, const ParamTuple& params, const ValueTuple& args); const S parent; const PrimString value_; @@ -207,14 +237,14 @@ if (params.Size() != label.param_count){ FAIL() << "Wrong number of params"; } - if (&label == &Function_Builder_append) { + if (&label == &Function_Append_append) { TRACE_FUNCTION("StringBuilder.append") std::lock_guard lock(mutex); output_ << args.At(0)->AsString(); return ReturnTuple(self); } - if (&label == &Function_Builder_build) { - TRACE_FUNCTION("SimpleOutput.build") + if (&label == &Function_Build_build) { + TRACE_FUNCTION("StringBuilder.build") std::lock_guard lock(mutex); return ReturnTuple(Box_String(output_.str())); } @@ -226,6 +256,10 @@ std::ostringstream output_; }; +ReturnTuple Type_String::Call_default(const ParamTuple& params, const ValueTuple& args) { + TRACE_FUNCTION("String.default") + return ReturnTuple(Box_String("")); +} ReturnTuple Type_String::Call_builder(const ParamTuple& params, const ValueTuple& args) { TRACE_FUNCTION("String.builder") return ReturnTuple(S(new Value_StringBuilder)); @@ -250,16 +284,16 @@ TRACE_FUNCTION("String.formatted") return ReturnTuple(Var_self); } -ReturnTuple Value_String::Call_readPosition(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("String.readPosition") +ReturnTuple Value_String::Call_readAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { + TRACE_FUNCTION("String.readAt") const PrimInt Var_arg1 = (args.At(0))->AsInt(); if (Var_arg1 < 0 || Var_arg1 >= value_.size()) { FAIL() << "Read position " << Var_arg1 << " is out of bounds"; } return ReturnTuple(Box_Char(value_[Var_arg1])); } -ReturnTuple Value_String::Call_readSize(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("String.readSize") +ReturnTuple Value_String::Call_size(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { + TRACE_FUNCTION("String.size") return ReturnTuple(Box_Int(value_.size())); } ReturnTuple Value_String::Call_subSequence(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { diff --git a/base/builtin.0rp b/base/builtin.0rp --- a/base/builtin.0rp +++ b/base/builtin.0rp @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- -Copyright 2019-2020 Kevin P. Barry +Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -16,15 +16,26 @@ // Author: Kevin P. Barry [ta0kira@gmail.com] +// Built-in boolean type. +// +// Literals are true and false. concrete Bool { refines AsBool refines AsInt refines AsFloat refines Formatted + defines Default defines Equals } +// Built-in character type. (ASCII only.) +// +// Literals: +// - Printable: 'a', '0', etc. +// - Escapes: '\n', '\r', etc. ('\0' must be '\000', however) +// - Hex: '\xAB' (always 2 digits) +// - Oct: '\012' (always 3 digits) concrete Char { refines AsBool refines AsChar @@ -32,20 +43,39 @@ refines AsFloat refines Formatted + defines Default defines Equals defines LessThan } +// Built-in double-precision floating point. +// +// Literals: +// - . required, with at least one digit on either side, e.g., 0.1 +// - Scientific notation: 0.1E-10, etc. concrete Float { refines AsBool refines AsInt refines AsFloat refines Formatted + defines Default defines Equals defines LessThan } +// Built-in 64-bit signed integer. +// +// Literals: +// - Decimal: 1234, -1234, etc. +// - Hex: \xABCD, etc. +// - Octal: \o7772, etc. +// - Binary: \b0110, etc. +// +// Notes: +// - Overflow will cause a compilation error. +// - Hex, oct, and binary escapes can go up to 2^64-1 to allow use of all 64 +// bits, but they will still be used as signed values. concrete Int { refines AsBool refines AsChar @@ -53,56 +83,125 @@ refines AsFloat refines Formatted + defines Default defines Equals defines LessThan } +// Built-in string of characters. (ASCII only.) +// +// Literals: Quote Char sequence with ". concrete String { refines AsBool refines Formatted - refines ReadPosition + refines ReadAt + refines SubSequence + defines Default defines Equals defines LessThan - @type builder () -> (Builder) + // Get a builder to create a string using concatenation. + // + // Example: + // + // String.builder().append("foo").append("bar").build() + @type builder () -> ([Append&Build]) } +// Convertible to Bool. @value interface AsBool { + // Convert the value to Bool. asBool () -> (Bool) } +// Convertible to Char. @value interface AsChar { + // Convert the value to Char. asChar () -> (Char) } +// Convertible to Float. @value interface AsFloat { + // Convert the value to Float. asFloat () -> (Float) } +// Convertible to Int. @value interface AsInt { + // Convert the value to Int. asInt () -> (Int) } +// Formattable as a String. @value interface Formatted { + // Format the value as a String. (Does not need to be reversible.) formatted () -> (String) } -@value interface ReadPosition<|#x> { - readPosition (Int) -> (#x) - readSize () -> (Int) - subSequence (Int,Int) -> (#self) +// Supports appending. +// +// Params: +// - #x: The value type to append. +@value interface Append<#x|> { + // Append a value and return self. + append (#x) -> (#self) } -@value interface Builder<#x> { - append (#x) -> (#self) +// Supports building a value from the current state. +// +// Params: +// - #x: The value type to build. +@value interface Build<|#x> { + // Build and return a value from the current state. build () -> (#x) } +// Contains a flexible number of values of some type. +@value interface Container { + // Return the number of values. + size () -> (Int) +} + +// Random-access reading from a container. +// +// Params: +// - #x: The value type contained. +@value interface ReadAt<|#x> { + refines Container + + // Return the value at the given index. + readAt (Int) -> (#x) +} + +// Sequence that can be subsequenced. +@value interface SubSequence { + refines Container + + // Return a copy of a subsequence. + subSequence (Int,Int) -> (#self) +} + +// The type has a default value. +@type interface Default { + // Return a new copy of the default value. + default () -> (#self) +} + +// The type can compare values for equality. +// +// Params: +// - #x: The value type to be compared. @type interface Equals<#x|> { + // Returns true iff the two values are equal. Must be symmetric. equals (#x,#x) -> (Bool) } +// The type can compare values for less-than. +// +// Params: +// - #x: The value type to be compared. @type interface LessThan<#x|> { + // Returns true iff the first value is less than the second. lessThan (#x,#x) -> (Bool) } diff --git a/base/category-source.hpp b/base/category-source.hpp --- a/base/category-source.hpp +++ b/base/category-source.hpp @@ -36,6 +36,11 @@ __builtin_unreachable(); \ } +#define RAW_FAIL(e) { \ + FAIL() << e; \ + __builtin_unreachable(); \ + } + extern const S& Var_empty; S Box_Bool(bool value); @@ -187,7 +192,27 @@ const ParamTuple& params, const ValueTuple& args); }; -template -using WeakInstanceMap = std::map::Type, S>; +template +class InstanceCache { + public: + using Creator = std::function(typename Params

::Type)>; + + InstanceCache(const Creator& create) : create_(create) {} + + S GetOrCreate(typename Params

::Type params) { + std::lock_guard lock(mutex_); + auto& cached = cache_[GetKeyFromParams

(params)]; + S type = cached; + if (!type) { + cached = type = create_(params); + } + return type; + } + + private: + const Creator create_; + std::mutex mutex_; + std::map::Type, S> cache_; +}; #endif // CATEGORY_SOURCE_HPP_ diff --git a/bin/zeolite-setup.hs b/bin/zeolite-setup.hs --- a/bin/zeolite-setup.hs +++ b/bin/zeolite-setup.hs @@ -22,6 +22,7 @@ import System.Exit import System.IO +import Base.CompilerError import Base.TrackedErrors import Cli.CompileOptions import Cli.RunCompiler @@ -57,11 +58,17 @@ "base", "lib/testing", "lib/util", + "lib/container", "lib/file", "lib/math", "tests" ] +optionalLibraries :: [String] +optionalLibraries = [ + "lib/thread" + ] + includePaths :: [String] includePaths = ["lib"] @@ -137,4 +144,7 @@ coMode = CompileRecompileRecursive, coForce = ForceAll } - tryTrackedErrorsIO "Warnings:" "Zeolite setup failed:" $ runCompiler resolver backend options + tryTrackedErrorsIO "Warnings:" "Zeolite setup failed:" $ do + runCompiler resolver backend options + mapM_ optionalWarning optionalLibraries where + optionalWarning library = compilerWarningM $ "Optional library " ++ library ++ " must be built manually if needed" diff --git a/example/hello/hello-demo.0rx b/example/hello/hello-demo.0rx --- a/example/hello/hello-demo.0rx +++ b/example/hello/hello-demo.0rx @@ -15,7 +15,7 @@ .append("What is your name? ") .writeTo(SimpleOutput.stderr()) String name <- reader.readNextLine() - if (name.readSize() == 0) { + if (name.size() == 0) { break } \ LazyStream.new() diff --git a/example/parser/parse-text.0rx b/example/parser/parse-text.0rx --- a/example/parser/parse-text.0rx +++ b/example/parser/parse-text.0rx @@ -11,9 +11,9 @@ ParseContext context <- contextOld scoped { Int index <- 0 - } in while (index < match.readSize()) { + } in while (index < match.size()) { $ReadOnly[context,index]$ - if (context.atEof() || context.current() != match.readPosition(index)) { + if (context.atEof() || context.current() != match.readAt(index)) { if (index > 0) { // Partial match => set error context. return context.setBrokenInput(message) @@ -48,17 +48,17 @@ min.formatted() + "," + max.formatted() + "} at " + contextOld.getPosition() ParseContext context <- contextOld - Builder builder <- String.builder() + [Append&Build] builder <- String.builder() Int count <- 0 while (!context.atEof() && (max == 0 || count < max)) { $ReadOnly[context,count]$ Bool found <- false scoped { Int index <- 0 - } in while (index < matches.readSize()) { + } in while (index < matches.size()) { $ReadOnly[index]$ - if (context.current() == matches.readPosition(index)) { - \ builder.append(matches.readPosition(index).formatted()) + if (context.current() == matches.readAt(index)) { + \ builder.append(matches.readAt(index).formatted()) found <- true break } diff --git a/example/parser/parser.0rx b/example/parser/parser.0rx --- a/example/parser/parser.0rx +++ b/example/parser/parser.0rx @@ -67,7 +67,7 @@ } atEof () { - return index >= data.readSize() + return index >= data.size() } hasAnyError () { @@ -80,12 +80,12 @@ current () { \ sanityCheck() - return data.readPosition(index) + return data.readAt(index) } advance () { \ sanityCheck() - if (data.readPosition(index) == '\n') { + if (data.readAt(index) == '\n') { return #self{ data, index+1, line+1, 1, value, error } } else { return #self{ data, index+1, line, char+1, value, error } diff --git a/example/tree/README.md b/example/tree/README.md deleted file mode 100644 --- a/example/tree/README.md +++ /dev/null @@ -1,20 +0,0 @@ -# Zeolite Tree Example - -*Also see -[a highlighted version of the example code](https://ta0kira.github.io/zeolite/example/tree).* - -To run the example: - -```shell -# This is just to locate the example code. Not for normal use! -ZEOLITE_PATH=$(zeolite --get-path) - -# Compile the example. -zeolite -p "$ZEOLITE_PATH" -I lib/util -m TreeDemo example/tree - -# Run the unit tests. -zeolite -p "$ZEOLITE_PATH" -t example/tree - -# Execute the compiled binary. -$ZEOLITE_PATH/example/tree/TreeDemo -``` diff --git a/example/tree/tree-demo.0rx b/example/tree/tree-demo.0rx deleted file mode 100644 --- a/example/tree/tree-demo.0rx +++ /dev/null @@ -1,54 +0,0 @@ -concrete TreeDemo { - @type run () -> () -} - -define TreeDemo { - run () { - TypeTree tree <- TypeTree.new() - - TypeKey keyInt <- TypeKey.new() - TypeKey keyString <- TypeKey.new() - TypeKey keyFloat <- TypeKey.new() - TypeKey keyValue <- TypeKey.new() - - \ tree.set(keyInt,1) - \ tree.set(keyString,"a") - - \ check(tree,keyInt) - \ check(tree,keyString) - \ check(tree,keyFloat) // Not found, since we never added a value. - - \ tree.set(keyValue,Value.new()) - \ check(tree,keyValue) - } - - @category check<#x> - #x requires Formatted - (TypeTree,TypeKey<#x>) -> () - check (tree,key) { - scoped { - optional #x value <- tree.get<#x>(key) - } in if (present(value)) { - \ LazyStream.new() - .append("Found '") - .append(require(value)) - .append("'\n") - .writeTo(SimpleOutput.stderr()) - } else { - \ LazyStream.new() - .append(typename>()) - .append(" Not Found\n") - .writeTo(SimpleOutput.stderr()) - } - } -} - -concrete Value { - refines Formatted - @type new () -> (Value) -} - -define Value { - new () { return Value{} } - formatted () { return "Value" } -} diff --git a/example/tree/tree-test.0rt b/example/tree/tree-test.0rt deleted file mode 100644 --- a/example/tree/tree-test.0rt +++ /dev/null @@ -1,62 +0,0 @@ -// Each testcase is essentially followed by its own private .0rx that is -// separate from all other testcases. In addition to category declarations and -// definitions, each testcase can define one or more unittest procedures. -// -// In this example, "success" means that all unittest are expected to succeed. -// The other options are "crash" for a runtime failure and "error" for a -// compilation error. - -testcase "integration test" { - success -} - -// Everything past here until the next testcase belongs to this testcase. This -// allows you to perform additional setup. - -// Each unittest is executed separately. If one unittest updates global state, -// it won't affect any other unittest. - -unittest test { - // Just select the required usage patterns with an intersection. - [KVWriter&KVReader] tree <- Tree.new() - Int count <- 30 - - // Insert values. - scoped { - Int i <- 0 - } in while (i < count) { - Int new <- ((i + 13) * 3547) % count - \ tree.set(new,i) - } update { - i <- i+1 - } - - // Verify and remove values. - scoped { - Int i <- 0 - } in while (i < count) { - Int new <- ((i + 13) * 3547) % count - scoped { - optional Int value <- tree.get(new) - } in if (!present(value)) { - \ LazyStream.new() - .append("Not found ") - .append(new) - .append(" but should have been ") - .append(i) - .writeTo(SimpleOutput.error()) - } elif (require(value) != i) { - \ LazyStream.new() - .append("Element ") - .append(new) - .append(" should have been ") - .append(i) - .append(" but was ") - .append(require(value)) - .writeTo(SimpleOutput.error()) - } - \ tree.remove(new) - } update { - i <- i+1 - } -} diff --git a/example/tree/tree.0rp b/example/tree/tree.0rp deleted file mode 100644 --- a/example/tree/tree.0rp +++ /dev/null @@ -1,30 +0,0 @@ -/* An interface for updating a key-value index. - */ -@value interface KVWriter<#k,#v|> { - // #self below always means the type of value that the function is being - // called from. For example, the type of foo.remove(key) is the same type as - // foo is. - - set (#k,#v) -> (#self) - remove (#k) -> (#self) -} - -/* An interface for looking up values from a key-value index. - */ -@value interface KVReader<#k|#v> { - get (#k) -> (optional #v) -} - -/* An AVL implementation of KVWriter and KVReader. - */ -concrete Tree<#k,#v> { - refines KVWriter<#k,#v> - refines KVReader<#k,#v> - #k defines LessThan<#k> - - // Creates a new Tree, e.g., Tree.new(). - @type new () -> (Tree<#k,#v>) - - // Since set and remove return #self, their implementations in Tree must - // return Tree<#k,#v>. -} diff --git a/example/tree/tree.0rx b/example/tree/tree.0rx deleted file mode 100644 --- a/example/tree/tree.0rx +++ /dev/null @@ -1,262 +0,0 @@ -define Tree { - @value optional Node<#k,#v> root - - new () { - return #self{ empty } - } - - set (k,v) { - root <- Node<#k,#v>.insert(root,k,v) - return self - } - - remove (k) { - root <- Node<#k,#v>.delete(root,k) - return self - } - - get (k) { - return Node<#k,#v>.find(root,k) - } -} - -/* Represents the root of a subtree. - * - * Since this category is not declared in the .0rp, it is only visible within - * this .0rx file. - * - * This is separate from Tree so that the root can be empty, but Node otherwise - * handles all of the tree logic. - */ -concrete Node<#k,#v> { - #k defines LessThan<#k> - - // The functions below are the only ones visible to Tree. Other functions are - // declared in the definition of Node, and are only accessible to other - // functions within Node. - - @type insert (optional Node<#k,#v>,#k,#v) -> (optional Node<#k,#v>) - @type delete (optional Node<#k,#v>,#k) -> (optional Node<#k,#v>) - @type find (optional Node<#k,#v>,#k) -> (optional #v) -} - -define Node { - @value Int height - @value #k key - @value #v value - @value optional Node<#k,#v> lower - @value optional Node<#k,#v> higher - - insert (node,k,v) { - if (!present(node)) { - return #self{ 1, k, v, empty, empty } - } - Node<#k,#v> node2 <- require(node) - if (k `#k.lessThan` node2.getKey()) { - \ node2.setLower(insert(node2.getLower(),k,v)) - return rebalance(node2) - } elif (node2.getKey() `#k.lessThan` k) { - \ node2.setHigher(insert(node2.getHigher(),k,v)) - return rebalance(node2) - } else { - \ node2.setValue(v) - return node2 - } - } - - delete (node,k) { - if (!present(node)) { - return empty - } - Node<#k,#v> node2 <- require(node) - if (k `#k.lessThan` node2.getKey()) { - \ node2.setLower(delete(node2.getLower(),k)) - return rebalance(node2) - } elif (node2.getKey() `#k.lessThan` k) { - \ node2.setHigher(delete(node2.getHigher(),k)) - return rebalance(node2) - } else { - return rebalance(removeNode(node2)) - } - } - - find (node,k) { - if (present(node)) { - scoped { - Node<#k,#v> node2 <- require(node) - } in if (k `#k.lessThan` node2.getKey()) { - return find(node2.getLower(),k) - } elif (node2.getKey() `#k.lessThan` k) { - return find(node2.getHigher(),k) - } else { - return node2.getValue() - } - } else { - return empty - } - } - - @value updateHeight () -> () - updateHeight () { - scoped { - Int l <- 0 - Int h <- 0 - if (present(lower)) { - l <- require(lower).getHeight() - } - if (present(higher)) { - h <- require(higher).getHeight() - } - } in if (l > h) { - height <- l + 1 - } else { - height <- h + 1 - } - } - - @value getBalance () -> (Int) - getBalance () { - scoped { - Int l <- 0 - Int h <- 0 - if (present(lower)) { - l <- require(lower).getHeight() - } - if (present(higher)) { - h <- require(higher).getHeight() - } - } in return h - l - } - - @type rebalance (optional Node<#k,#v>) -> (optional Node<#k,#v>) - rebalance (node) { - if (!present(node)) { - return empty - } - Node<#k,#v> node2 <- require(node) - \ node2.updateHeight() - scoped { - Int balance <- node2.getBalance() - } in if (balance > 1) { - return pivotLower(node2) - } elif (balance < -1) { - return pivotHigher(node2) - } else { - return node2 - } - } - - @type pivotHigher (Node<#k,#v>) -> (Node<#k,#v>) - pivotHigher (node) (newNode) { - if (require(node.getLower()).getBalance() > 0) { - \ node.setLower(pivotLower(require(node.getLower()))) - } - newNode <- require(node.getLower()) - \ node.setLower(newNode.getHigher()) - \ node.updateHeight() - \ newNode.setHigher(node) - \ newNode.updateHeight() - } - - @type pivotLower (Node<#k,#v>) -> (Node<#k,#v>) - pivotLower (node) (newNode) { - if (require(node.getHigher()).getBalance() < 0) { - \ node.setHigher(pivotHigher(require(node.getHigher()))) - } - newNode <- require(node.getHigher()) - \ node.setHigher(newNode.getLower()) - \ node.updateHeight() - \ newNode.setLower(node) - \ newNode.updateHeight() - } - - @type removeNode (Node<#k,#v>) -> (optional Node<#k,#v>) - removeNode (node) (newNode) { - if (node.getBalance() < 0) { - optional Node<#k,#v> temp, newNode <- removeHighest(node.getLower()) - \ node.setLower(temp) - } else { - optional Node<#k,#v> temp, newNode <- removeLowest(node.getHigher()) - \ node.setHigher(temp) - } - if (present(newNode)) { - \ swapChildren(node,require(newNode)) - \ require(newNode).updateHeight() - } - } - - @type removeHighest (optional Node<#k,#v>) -> (optional Node<#k,#v>,optional Node<#k,#v>) - removeHighest (node) (newNode,removed) { - if (!present(node)) { - return empty, empty - } - Node<#k,#v> node2 <- require(node) - if (present(node2.getHigher())) { - optional Node<#k,#v> temp, removed <- removeHighest(node2.getHigher()) - \ node2.setHigher(temp) - newNode <- rebalance(node2) - } else { - newNode <- node2.getLower() - \ node2.setLower(empty) - removed <- node - } - } - - @type removeLowest (optional Node<#k,#v>) -> (optional Node<#k,#v>,optional Node<#k,#v>) - removeLowest (node) (newNode,removed) { - if (!present(node)) { - return empty, empty - } - Node<#k,#v> node2 <- require(node) - if (present(node2.getLower())) { - optional Node<#k,#v> temp, removed <- removeLowest(node2.getLower()) - \ node2.setLower(temp) - newNode <- rebalance(node2) - } else { - newNode <- node2.getHigher() - \ node2.setHigher(empty) - removed <- node - } - } - - @type swapChildren (Node<#k,#v>,Node<#k,#v>) -> () - swapChildren (l,r) { - scoped { - optional Node<#k,#v> temp <- l.getLower() - \ l.setLower(r.getLower()) - } in \ r.setLower(temp) - scoped { - optional Node<#k,#v> temp <- l.getHigher() - \ l.setHigher(r.getHigher()) - } in \ r.setHigher(temp) - } - - @value getHeight () -> (Int) - getHeight () { return height } - - // It is unsafe to change the key after construction, so there is no setter. - // - // Unlike other languages, a member is only accessible by the value that owns - // it. More specifically, @type functions in Node can only access @value - // members via explicit @value getters and setters. - @value getKey () -> (#k) - getKey () { return key } - - @value getValue () -> (#v) - getValue () { return value } - - @value setValue (#v) -> () - setValue (v) { value <- v } - - @value getLower () -> (optional Node<#k,#v>) - getLower () { return lower } - - @value setLower (optional Node<#k,#v>) -> () - setLower (l) { lower <- l } - - @value getHigher () -> (optional Node<#k,#v>) - getHigher () { return higher } - - @value setHigher (optional Node<#k,#v>) -> () - setHigher (h) { higher <- h } -} diff --git a/example/tree/type-tree.0rp b/example/tree/type-tree.0rp deleted file mode 100644 --- a/example/tree/type-tree.0rp +++ /dev/null @@ -1,50 +0,0 @@ -/* A key-value index that can hold multiple types of value. - * - * Each element in the index is keyed by a TypeKey that has a type param that - * matches the type of the value. - */ -concrete TypeTree { - // Creates a new TypeTree, e.g., TypeTree.new(). - @type new () -> (TypeTree) - - // Sets the value for the given key, inserting if necessary. - @value set<#x> (TypeKey<#x>,#x) -> (TypeTree) - - // Removes the value for the given key. - @value remove (TypeKey) -> (TypeTree) - - // Returns the value for the given key, or empty if: - // - There is no entry for the key. - // - The value for the key is not of type #x, e.g., was originally added to - // the tree as a parent of type #x. - @value get<#x> (TypeKey<#x>) -> (optional #x) -} - -/* A typed key for indexing values in TypeTree. - * - * A key of type TypeKey<#x> indexes a value of type #x. The key can also be - * used as a key for any parent type of #x. For example, if V -> I then - * TypeKey can be used as TypeKey. - */ -concrete TypeKey<|#x> { - // Note that TypeKey<#x> as a type argument for some #y can satisfy - // - // #y defines LessThan<#y> - // - // even though we only define LessThan>. - // - // This is non-trivial: - // - // - #x -> any, which is trivial. - // - TypeKey<#x> -> TypeKey, since TypeKey has a single covariant param. - // - LessThan> -> LessThan>, since LessThan has a - // single contravariant param. - // - TypeKey<#x> -> LessThan> -> LessThan>. - // - // This means that TypeKey<#x> can be used as a key in Tree. (See tree.0rp.) - defines LessThan> - defines Equals> - - // Creates a new TypeKey, e.g., TypeTree<#x>.new(). - @type new () -> (TypeKey<#x>) -} diff --git a/example/tree/type-tree.0rx b/example/tree/type-tree.0rx deleted file mode 100644 --- a/example/tree/type-tree.0rx +++ /dev/null @@ -1,93 +0,0 @@ -define TypeTree { - // Since TypeKey and LockedType each have a covariant param, setting the param - // to any in Tree means that any param can be used in an assignment. - // - // The catch is that any cannot be converted to anything else, which means - // that type information is no longer directly accessible. LockedType allows - // the original type to be recovered via check, given the correct TypeKey. - @value Tree,LockedType> tree - - new () { - return TypeTree{ Tree,LockedType>.new() } - } - - set (k,v) { - \ tree.set(k,LockedType:create(k,v)) - return self - } - - remove (k) { - \ tree.remove(k) - return self - } - - get (k) { - scoped { - optional LockedType value <- tree.get(k) - } in if (present(value)) { - return require(value).check(k) - } else { - return empty - } - } -} - -define TypeKey { - @category Int counter <- 0 - @value Int index - - new () { - return TypeKey<#x>{ (counter <- counter+1) } - } - - lessThan (l,r) { - return l.get() < r.get() - } - - equals (l,r) { - return l.get() == r.get() - } - - @value get () -> (Int) - get () { - return index - } -} - -/* An internal type used for storing a single value. - * - * The contained value is only accessible via the check function, which ensures - * both that the key and the type match. - */ -concrete LockedType<|#x> { - // Creates a new LockedType, e.g., LockedType:create<#x>(k,v). - @category create<#x> (TypeKey<#x>,#x) -> (LockedType<#x>) - - // Returns the contained value if the key and type match, or empty otherwise. - @value check<#y> (TypeKey<#y>) -> (optional #y) -} - -define LockedType { - @value TypeKey<#x> key - @value #x value - - create (k,v) { - return LockedType<#x>{ k, v } - } - - check (k) { - if (key `TypeKey.equals` k) { - // reduce is a builtin that returns value (as optional #y) iff #x -> #y. - // The runtime type of value does not matter here; it just needs to be of - // type optional #x at compile time. - // - // This is more like template meta-programming in C++ than it is like - // instanceof or reflection in Java. The reduce call could in theory be - // replaced at compile time with either value or empty if parameter - // substitution happened at compile time. (Like C++ does with templates.) - return reduce<#x,#y>(value) - } else { - return empty - } - } -} diff --git a/lib/container/.zeolite-module b/lib/container/.zeolite-module new file mode 100644 --- /dev/null +++ b/lib/container/.zeolite-module @@ -0,0 +1,15 @@ +root: "../.." +path: "lib/container" +public_deps: [ + "lib/util" +] +private_deps: [ + "lib/testing" +] +extra_files: [ + category_source { + source: "lib/container/src/Extension_Vector.cpp" + categories: [Vector] + } +] +mode: incremental {} diff --git a/lib/container/README.md b/lib/container/README.md new file mode 100644 --- /dev/null +++ b/lib/container/README.md @@ -0,0 +1,12 @@ +# [Zeolite Container Library](https://github.com/ta0kira/zeolite/tree/master/lib/container) + +## Library Usage + +- See filenames ending in `.0rp` for documentation. + +- Include `"lib/container"` in `public_deps` or `private_deps` in your + `.zeolite-module`. + +## Configuring and Building + +This library is automatically built by `zeolite-setup`. diff --git a/lib/container/interfaces.0rp b/lib/container/interfaces.0rp new file mode 100644 --- /dev/null +++ b/lib/container/interfaces.0rp @@ -0,0 +1,52 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// Container with stack semantics. +// +// Params: +// - #x: The value type to stack. +@value interface Stack<#x> { + refines Container + + // Pushes a new value and returns self. + push (#x) -> (#self) + // Pops the top value. Crashes if empty. (Check size() before calling.) + pop () -> (#x) +} + +// Writing to key-value storage. +// +// Params: +// - #k: The key type. +// - #v: The value type. +@value interface KVWriter<#k,#v|> { + // Sets or replaces the value associated with the key and returns self. + set (#k,#v) -> (#self) + // Removes the value associated with the key if present and returns self. + remove (#k) -> (#self) +} + +// Reading from key-value storage. +// +// Params: +// - #k: The key type. +// - #v: The value type. +@value interface KVReader<#k|#v> { + // Returns the value associated with the key if present. + get (#k) -> (optional #v) +} diff --git a/lib/container/search-tree.0rp b/lib/container/search-tree.0rp new file mode 100644 --- /dev/null +++ b/lib/container/search-tree.0rp @@ -0,0 +1,50 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// A binary search tree for key-value storage. +// +// Params: +// - #k: The key type. +// - #v: The value type. +concrete SearchTree<#k,#v> { + refines KVWriter<#k,#v> + refines KVReader<#k,#v> + #k defines LessThan<#k> + + // Create an empty tree. + @type new () -> (#self) +} + +// A validated binary search tree for key-value storage. +// +// Params: +// - #k: The key type. +// - #v: The value type. +// +// Notes: +// - This is the same as SearchTree, but it validates the tree structure every +// time there is a modification, which is extremely inefficient. This should +// therefore only be used in tests. +concrete ValidatedTree<#k,#v> { + refines KVWriter<#k,#v> + refines KVReader<#k,#v> + #k defines LessThan<#k> + + // Create an empty tree. + @type new () -> (#self) +} diff --git a/lib/container/search-tree.0rt b/lib/container/search-tree.0rt new file mode 100644 --- /dev/null +++ b/lib/container/search-tree.0rt @@ -0,0 +1,64 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "integration test" { + success +} + +unittest test { + [KVWriter&KVReader] tree <- ValidatedTree.new() + Int count <- 30 + + // Insert values. + scoped { + Int i <- 0 + } in while (i < count) { + Int new <- ((i + 13) * 3547) % count + \ tree.set(new,i) + } update { + i <- i+1 + } + + scoped { + Int i <- 0 + } in while (i < count) { + Int new <- ((i + 13) * 3547) % count + scoped { + optional Int value <- tree.get(new) + } in if (!present(value)) { + \ LazyStream.new() + .append("Not found ") + .append(new) + .append(" but should have been ") + .append(i) + .writeTo(SimpleOutput.error()) + } elif (require(value) != i) { + \ LazyStream.new() + .append("Element ") + .append(new) + .append(" should have been ") + .append(i) + .append(" but was ") + .append(require(value)) + .writeTo(SimpleOutput.error()) + } + \ tree.remove(new) + } update { + i <- i+1 + } +} diff --git a/lib/container/search-tree.0rx b/lib/container/search-tree.0rx new file mode 100644 --- /dev/null +++ b/lib/container/search-tree.0rx @@ -0,0 +1,331 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +define SearchTree { + @value optional Node<#k,#v> root + + new () { + return #self{ empty } + } + + set (k,v) { + root <- Node<#k,#v>.insert(root,k,v) + return self + } + + remove (k) { + root <- Node<#k,#v>.delete(root,k) + return self + } + + get (k) { + return Node<#k,#v>.find(root,k) + } +} + +define ValidatedTree { + @value optional Node<#k,#v> root + + new () { + return #self{ empty } + } + + set (k,v) { + root <- Node<#k,#v>.insert(root,k,v) + \ Node<#k,#v>.validate(root) + return self + } + + remove (k) { + root <- Node<#k,#v>.delete(root,k) + \ Node<#k,#v>.validate(root) + return self + } + + get (k) { + return Node<#k,#v>.find(root,k) + } +} + +concrete Node<#k,#v> { + #k defines LessThan<#k> + + @type insert (optional Node<#k,#v>,#k,#v) -> (optional Node<#k,#v>) + @type delete (optional Node<#k,#v>,#k) -> (optional Node<#k,#v>) + @type find (optional Node<#k,#v>,#k) -> (optional #v) + @type validate (optional Node<#k,#v>) -> () +} + +define Node { + @value Int height + @value #k key + @value #v value + @value optional Node<#k,#v> lower + @value optional Node<#k,#v> higher + + insert (node,k,v) { + if (!present(node)) { + return #self{ 1, k, v, empty, empty } + } + Node<#k,#v> node2 <- require(node) + if (k `#k.lessThan` node2.getKey()) { + \ node2.setLower(insert(node2.getLower(),k,v)) + return rebalance(node2) + } elif (node2.getKey() `#k.lessThan` k) { + \ node2.setHigher(insert(node2.getHigher(),k,v)) + return rebalance(node2) + } else { + \ node2.setValue(v) + return node2 + } + } + + delete (node,k) { + if (!present(node)) { + return empty + } + Node<#k,#v> node2 <- require(node) + if (k `#k.lessThan` node2.getKey()) { + \ node2.setLower(delete(node2.getLower(),k)) + return rebalance(node2) + } elif (node2.getKey() `#k.lessThan` k) { + \ node2.setHigher(delete(node2.getHigher(),k)) + return rebalance(node2) + } else { + return rebalance(removeNode(node2)) + } + } + + find (node,k) { + if (present(node)) { + scoped { + Node<#k,#v> node2 <- require(node) + } in if (k `#k.lessThan` node2.getKey()) { + return find(node2.getLower(),k) + } elif (node2.getKey() `#k.lessThan` k) { + return find(node2.getHigher(),k) + } else { + return node2.getValue() + } + } else { + return empty + } + } + + validate (node) { + if (present(node)) { + \ require(node).validateOrder() + \ require(node).validateBalance() + } + } + + @value validateOrder () -> () + validateOrder () { + if (present(lower)) { + if (!(require(lower).getKey() `#k.lessThan` getKey())) { + fail("bad lower order") + } + \ require(lower).validateOrder() + } + if (present(higher)) { + if (!(getKey() `#k.lessThan` require(higher).getKey())) { + fail("bad higher order") + } + \ require(higher).validateOrder() + } + } + + @value validateBalance () -> () + validateBalance () { + scoped { + Int balance <- getBalance() + } in if (balance > 1 || balance < -1) { + fail("out of balance: " + balance.formatted()) + } + if (present(lower)) { + \ require(lower).validateBalance() + } + if (present(higher)) { + \ require(higher).validateBalance() + } + } + + @value updateHeight () -> () + updateHeight () { + scoped { + Int l <- 0 + Int h <- 0 + if (present(lower)) { + l <- require(lower).getHeight() + } + if (present(higher)) { + h <- require(higher).getHeight() + } + } in if (l > h) { + height <- l + 1 + } else { + height <- h + 1 + } + } + + @value getBalance () -> (Int) + getBalance () { + scoped { + Int l <- 0 + Int h <- 0 + if (present(lower)) { + l <- require(lower).getHeight() + } + if (present(higher)) { + h <- require(higher).getHeight() + } + } in return h - l + } + + @type rebalance (optional Node<#k,#v>) -> (optional Node<#k,#v>) + rebalance (node) { + if (!present(node)) { + return empty + } + Node<#k,#v> node2 <- require(node) + \ node2.updateHeight() + scoped { + Int balance <- node2.getBalance() + } in if (balance > 1) { + return pivotLower(node2) + } elif (balance < -1) { + return pivotHigher(node2) + } else { + return node2 + } + } + + @type pivotHigher (Node<#k,#v>) -> (Node<#k,#v>) + pivotHigher (node) (newNode) { + if (require(node.getLower()).getBalance() > 0) { + \ node.setLower(pivotLower(require(node.getLower()))) + } + newNode <- require(node.getLower()) + \ node.setLower(newNode.getHigher()) + \ node.updateHeight() + \ newNode.setHigher(node) + \ newNode.updateHeight() + } + + @type pivotLower (Node<#k,#v>) -> (Node<#k,#v>) + pivotLower (node) (newNode) { + if (require(node.getHigher()).getBalance() < 0) { + \ node.setHigher(pivotHigher(require(node.getHigher()))) + } + newNode <- require(node.getHigher()) + \ node.setHigher(newNode.getLower()) + \ node.updateHeight() + \ newNode.setLower(node) + \ newNode.updateHeight() + } + + @type removeNode (Node<#k,#v>) -> (optional Node<#k,#v>) + removeNode (node) (newNode) { + if (node.getBalance() < 0) { + optional Node<#k,#v> temp, newNode <- removeHighest(node.getLower()) + \ node.setLower(temp) + } else { + optional Node<#k,#v> temp, newNode <- removeLowest(node.getHigher()) + \ node.setHigher(temp) + } + if (present(newNode)) { + \ swapChildren(node,require(newNode)) + \ require(newNode).updateHeight() + } + } + + @type removeHighest (optional Node<#k,#v>) -> (optional Node<#k,#v>,optional Node<#k,#v>) + removeHighest (node) (newNode,removed) { + if (!present(node)) { + return empty, empty + } + Node<#k,#v> node2 <- require(node) + if (present(node2.getHigher())) { + optional Node<#k,#v> temp, removed <- removeHighest(node2.getHigher()) + \ node2.setHigher(temp) + newNode <- rebalance(node2) + } else { + newNode <- node2.getLower() + \ node2.setLower(empty) + removed <- node + } + } + + @type removeLowest (optional Node<#k,#v>) -> (optional Node<#k,#v>,optional Node<#k,#v>) + removeLowest (node) (newNode,removed) { + if (!present(node)) { + return empty, empty + } + Node<#k,#v> node2 <- require(node) + if (present(node2.getLower())) { + optional Node<#k,#v> temp, removed <- removeLowest(node2.getLower()) + \ node2.setLower(temp) + newNode <- rebalance(node2) + } else { + newNode <- node2.getHigher() + \ node2.setHigher(empty) + removed <- node + } + } + + @type swapChildren (Node<#k,#v>,Node<#k,#v>) -> () + swapChildren (l,r) { + scoped { + optional Node<#k,#v> temp <- l.getLower() + \ l.setLower(r.getLower()) + } in \ r.setLower(temp) + scoped { + optional Node<#k,#v> temp <- l.getHigher() + \ l.setHigher(r.getHigher()) + } in \ r.setHigher(temp) + } + + @value getHeight () -> (Int) + getHeight () { return height } + + // It is unsafe to change the key after construction, so there is no setter. + // + // Unlike other languages, a member is only accessible by the value that owns + // it. More specifically, @type functions in Node can only access @value + // members via explicit @value getters and setters. + @value getKey () -> (#k) + getKey () { return key } + + @value getValue () -> (#v) + getValue () { return value } + + @value setValue (#v) -> () + setValue (v) { value <- v } + + @value getLower () -> (optional Node<#k,#v>) + getLower () { return lower } + + @value setLower (optional Node<#k,#v>) -> () + setLower (l) { lower <- l } + + @value getHigher () -> (optional Node<#k,#v>) + getHigher () { return higher } + + @value setHigher (optional Node<#k,#v>) -> () + setHigher (h) { higher <- h } +} diff --git a/lib/container/src/Extension_Vector.cpp b/lib/container/src/Extension_Vector.cpp new file mode 100644 --- /dev/null +++ b/lib/container/src/Extension_Vector.cpp @@ -0,0 +1,157 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include +#include + +#include "category-source.hpp" +#include "Streamlined_Vector.hpp" +#include "Category_Append.hpp" +#include "Category_Container.hpp" +#include "Category_Default.hpp" +#include "Category_Formatted.hpp" +#include "Category_ReadAt.hpp" +#include "Category_Stack.hpp" +#include "Category_String.hpp" +#include "Category_Vector.hpp" +#include "Category_WriteAt.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +using VectorType = std::vector>; + +S CreateValue_Vector(S parent, const ParamTuple& params, VectorType values); + +struct ExtCategory_Vector : public Category_Vector { + ReturnTuple Call_copyFrom(const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector:copyFrom") + const S Param_y = params.At(0); + const S& Var_arg1 = (args.At(0)); + VectorType values; + const PrimInt size = TypeValue::Call(Var_arg1, Function_Container_size, ParamTuple(), ArgTuple()).Only()->AsInt(); + for (int i = 0; i < size; ++i) { + values.push_back(TypeValue::Call(Var_arg1, Function_ReadAt_readAt, ParamTuple(), ArgTuple(Box_Int(i))).Only()); + } + return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), ParamTuple(), values)); + } + + ReturnTuple Call_create(const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector:create") + const S Param_y = params.At(0); + return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), ParamTuple(), VectorType())); + } + + ReturnTuple Call_createSize(const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector:createSize") + const S Param_y = params.At(0); + const PrimInt Var_arg1 = (args.At(0))->AsInt(); + VectorType values; + for (int i = 0; i < Var_arg1; ++i) { + values.push_back(TypeInstance::Call(Param_y, Function_Default_default, ParamTuple(), ArgTuple()).Only()); + } + return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), ParamTuple(), values)); + } +}; + +struct ExtType_Vector : public Type_Vector { + inline ExtType_Vector(Category_Vector& p, Params<1>::Type params) : Type_Vector(p, params) {} +}; + +struct ExtValue_Vector : public Value_Vector { + inline ExtValue_Vector(S p, const ParamTuple& params, VectorType v) + : Value_Vector(p, params), values(std::move(v)) {} + + ReturnTuple Call_append(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector.append") + std::lock_guard lock(mutex); + const S& Var_arg1 = (args.At(0)); + values.push_back(Var_arg1); + return ReturnTuple(Var_self); + } + + ReturnTuple Call_pop(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector.pop") + std::lock_guard lock(mutex); + if (values.empty()) { + BUILTIN_FAIL(Box_String(PrimString_FromLiteral("no elements left to pop"))) + } + S value = values.back(); + values.pop_back(); + return ReturnTuple(value); + } + + ReturnTuple Call_push(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector.push") + std::lock_guard lock(mutex); + const S& Var_arg1 = (args.At(0)); + values.push_back(Var_arg1); + return ReturnTuple(Var_self); + } + + ReturnTuple Call_readAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector.readAt") + std::lock_guard lock(mutex); + const PrimInt Var_arg1 = (args.At(0))->AsInt(); + if (Var_arg1 < 0 || Var_arg1 >= values.size()) { + FAIL() << "index " << Var_arg1 << " is out of bounds"; + } + return ReturnTuple(values[Var_arg1]); + } + + ReturnTuple Call_size(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector.size") + std::lock_guard lock(mutex); + return ReturnTuple(Box_Int(values.size())); + } + + ReturnTuple Call_writeAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Vector.writeAt") + std::lock_guard lock(mutex); + const PrimInt Var_arg1 = (args.At(0))->AsInt(); + const S& Var_arg2 = (args.At(1)); + if (Var_arg1 < 0 || Var_arg1 >= values.size()) { + FAIL() << "index " << Var_arg1 << " is out of bounds"; + } + values[Var_arg1] = Var_arg2; + return ReturnTuple(Var_self); + } + + std::mutex mutex; + VectorType values; +}; + +Category_Vector& CreateCategory_Vector() { + static auto& category = *new ExtCategory_Vector(); + return category; +} +S CreateType_Vector(Params<1>::Type params) { + static auto& cache = *new InstanceCache<1, Type_Vector>([](Params<1>::Type params) { + return S_get(new ExtType_Vector(CreateCategory_Vector(), params)); + }); + return cache.GetOrCreate(params); +} +S CreateValue_Vector(S parent, const ParamTuple& params, VectorType values) { + return S_get(new ExtValue_Vector(parent, params, values)); +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/container/type-map.0rp b/lib/container/type-map.0rp new file mode 100644 --- /dev/null +++ b/lib/container/type-map.0rp @@ -0,0 +1,55 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// A map that stores values of arbitrary types. +concrete TypeMap { + // Create a new map. + @type new () -> (TypeMap) + + // Set or replace the value associated with the key. + // + // Params: + // - #x: The value type being stored. + @value set<#x> (TypeKey<#x>,#x) -> (TypeMap) + + // Remove the value associated with the key if present and return self. + @value remove (TypeKey) -> (TypeMap) + + // Return the value associated with the key if present. + // + // Params: + // - #x: The value type being returned. + // + // Notes: + // - #x does not need to be the same type as the original value, since TypeKey + // has a covariant parameter. + // - The value will only be returned if it can be converted to #x. For + // example, if the value is actually a String but it was added as Formatted + // (a parent of String), then the value cannot be retrieved as a String. + @value get<#x> (TypeKey<#x>) -> (optional #x) +} + +// A typed key for use with TypeMap. +concrete TypeKey<|#x> { + refines Formatted + defines LessThan> + defines Equals> + + // Create a new key. + @type new () -> (TypeKey<#x>) +} diff --git a/lib/container/type-map.0rt b/lib/container/type-map.0rt new file mode 100644 --- /dev/null +++ b/lib/container/type-map.0rt @@ -0,0 +1,100 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "TypeMap tests" { + success +} + +unittest basicOperations { + TypeMap tree <- TypeMap.new() + + TypeKey keyInt <- TypeKey.new() + TypeKey keyString <- TypeKey.new() + TypeKey keyValue <- TypeKey.new() + + \ Helper.check(tree,keyInt,empty) + \ Helper.check(tree,keyString,empty) + \ Helper.check(tree,keyValue,empty) + + \ tree.set(keyInt,1) + \ tree.set(keyString,"a") + \ tree.set(keyValue,Value.new()) + + \ Helper.check(tree,keyInt,1) + \ Helper.check(tree,keyString,"a") + \ Helper.check(tree,keyValue,Value.new()) + + \ tree.remove(keyString) + + \ Helper.check(tree,keyString,empty) +} + +unittest wrongReturnType { + TypeMap tree <- TypeMap.new() + + TypeKey keyString <- TypeKey.new() + + // Added as Formatted, which means it cannot be retrieved as String later. + \ tree.set(keyString,"a") + \ Helper.check(tree,keyString,empty) + + \ tree.set(keyString,"a") + \ Helper.check(tree,keyString,"a") +} + +concrete Value { + refines Formatted + defines Equals + + @type new () -> (Value) +} + +define Value { + new () { + return Value{ } + } + + formatted () { + return "Value" + } + + equals (_,_) { + return true + } +} + +concrete Helper { + @type check<#x> + #x requires Formatted + #x defines Equals<#x> + (TypeMap,TypeKey<#x>,optional #x) -> () +} + +define Helper { + check (tree,key,expected) { + scoped { + optional #x value <- tree.get<#x>(key) + } in if (present(value) && present(expected)) { + \ Testing.checkEquals(require(value),require(expected)) + } elif (!present(value) && present(expected)) { + fail(key.formatted() + " was expected but not found") + } elif (present(value) && !present(expected)) { + fail(key.formatted() + " was found but not expected") + } + } +} diff --git a/lib/container/type-map.0rx b/lib/container/type-map.0rx new file mode 100644 --- /dev/null +++ b/lib/container/type-map.0rx @@ -0,0 +1,99 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +define TypeMap { + @value SearchTree,LockedType> tree + + new () { + return TypeMap{ SearchTree,LockedType>.new() } + } + + set (k,v) { + \ tree.set(k,LockedType:create(k,v)) + return self + } + + remove (k) { + \ tree.remove(k) + return self + } + + get (k) { + scoped { + optional LockedType value <- tree.get(k) + } in if (present(value)) { + return require(value).check(k) + } else { + return empty + } + } +} + +define TypeKey { + // TODO: Protect the counter with a mutex. + @category Int counter <- 0 + @value Int index + + new () { + return TypeKey<#x>{ (counter <- counter+1) } + } + + formatted () { + return String.builder() + .append(typename<#self>().formatted()) + .append("{") + .append(index.formatted()) + .append("}") + .build() + } + + lessThan (l,r) { + return l.get() < r.get() + } + + equals (l,r) { + return l.get() == r.get() + } + + @value get () -> (Int) + get () { + return index + } +} + +concrete LockedType<|#x> { + @category create<#x> (TypeKey<#x>,#x) -> (LockedType<#x>) + @value check<#y> (TypeKey<#y>) -> (optional #y) +} + +define LockedType { + @value TypeKey<#x> key + @value #x value + + create (k,v) { + return LockedType<#x>{ k, v } + } + + check (k) { + if (key `TypeKey.equals` k) { + return reduce<#x,#y>(value) + } else { + return empty + } + } +} diff --git a/lib/container/vector.0rp b/lib/container/vector.0rp new file mode 100644 --- /dev/null +++ b/lib/container/vector.0rp @@ -0,0 +1,43 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// Random-access vector of values. +// +// Params: +// - #x: The value type contained. +concrete Vector<#x> { + refines Stack<#x> + refines ReadAt<#x> + refines WriteAt<#x> + refines Append<#x> + + // Create a copy from another random-access container. + @category copyFrom<#y> (ReadAt<#y>) -> (Vector<#y>) + + // Create an empty Vector. + @category create<#y> () -> (Vector<#y>) + + // Create a pre-sized vector of default values. + // + // Notes: + // - #y.default() should return a distinct value each time if #y is mutable. + // This means that modifying one element should not change others. + @category createSize<#y> + #y defines Default + (Int) -> (Vector<#y>) +} diff --git a/lib/container/vector.0rt b/lib/container/vector.0rt new file mode 100644 --- /dev/null +++ b/lib/container/vector.0rt @@ -0,0 +1,193 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "Vector tests" { + success +} + +unittest createSize { + Vector values <- Vector:createSize(10) + \ Testing.checkEquals(values.size(),10) + + scoped { + Int i <- 0 + } in while (i < values.size()) { + \ Testing.checkEquals(values.readAt(i),Int.default()) + } update { + i <- i+1 + } +} + +unittest copyFrom { + String original <- "abcde" + Vector values <- Vector:copyFrom(original) + \ Testing.checkEquals(values.size(),original.size()) + + scoped { + Int i <- 0 + } in while (i < original.size()) { + \ Testing.checkEquals(values.readAt(i),original.readAt(i)) + } update { + i <- i+1 + } +} + +unittest append { + Vector values <- Vector:create() + + scoped { + Int i <- 0 + } in while (i < 10) { + \ values.append(i) + \ Testing.checkEquals(values.size(),i+1) + } update { + i <- i+1 + } + \ Testing.checkEquals(values.size(),10) + + scoped { + Int i <- 0 + } in while (i < values.size()) { + \ Testing.checkEquals(values.readAt(i),i) + } update { + i <- i+1 + } +} + +unittest pushAndPop { + Vector values <- Vector:create() + + scoped { + Int i <- 0 + } in while (i < 10) { + \ values.push(i) + \ Testing.checkEquals(values.size(),i+1) + } update { + i <- i+1 + } + \ Testing.checkEquals(values.size(),10) + + scoped { + Int i <- 0 + } in while (i < 10) { + \ Testing.checkEquals(values.pop(),10-i-1) + \ Testing.checkEquals(values.size(),10-i-1) + } update { + i <- i+1 + } + \ Testing.checkEquals(values.size(),0) +} + +unittest writeAt { + Vector values <- Vector:createSize(10) + + scoped { + Int i <- 0 + } in while (i < values.size()) { + \ values.writeAt(i,2*i) + } update { + i <- i+1 + } + + scoped { + Int i <- 0 + } in while (i < values.size()) { + \ Testing.checkEquals(values.readAt(i),2*i) + } update { + i <- i+1 + } +} + +testcase "distinct default values in pre-sized Vector" { + success +} + +unittest test { + Vector values <- Vector:createSize(10) + \ values.readAt(3).set(7) + + \ Testing.checkEquals(values.readAt(3),Type.create(7)) + + scoped { + Int i <- 0 + } in while (i < values.size()) { + if (i != 3) { + \ Testing.checkEquals(values.readAt(i),Type.create(0)) + } + } update { + i <- i+1 + } +} + +concrete Type { + refines Formatted + defines Default + defines Equals + + @type create (Int) -> (Type) + @value set (Int) -> () +} + +define Type { + @value Int value + + default () { + return create(0) + } + + create (v) { + return Type{ v } + } + + formatted () { + return value.formatted() + } + + equals (x,y) { + return x.get() == y.get() + } + + set (v) { + value <- v + } + + @value get () -> (Int) + get () { + return value + } +} + + +testcase "negative Vector index" { + crash +} + +unittest test { + Vector values <- Vector:create() + \ values.readAt(-1) +} + + +testcase "Vector index out of bounds" { + crash +} + +unittest test { + Vector values <- Vector:create() + \ values.readAt(1) +} diff --git a/lib/file/.zeolite-module b/lib/file/.zeolite-module --- a/lib/file/.zeolite-module +++ b/lib/file/.zeolite-module @@ -1,5 +1,5 @@ -root: ".." -path: "file" +root: "../.." +path: "lib/file" public_deps: [ "lib/util" ] @@ -8,11 +8,11 @@ ] extra_files: [ category_source { - source: "file/Extension_RawFileReader.cpp" + source: "lib/file/src/Extension_RawFileReader.cpp" categories: [RawFileReader] } category_source { - source: "file/Extension_RawFileWriter.cpp" + source: "lib/file/src/Extension_RawFileWriter.cpp" categories: [RawFileWriter] } ] diff --git a/lib/file/Extension_RawFileReader.cpp b/lib/file/Extension_RawFileReader.cpp deleted file mode 100644 --- a/lib/file/Extension_RawFileReader.cpp +++ /dev/null @@ -1,128 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2020-2021 Kevin P. Barry -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - http://www.apache.org/licenses/LICENSE-2.0 -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -#include -#include - -#include "category-source.hpp" -#include "Streamlined_RawFileReader.hpp" -#include "Category_Formatted.hpp" -#include "Category_String.hpp" - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -namespace ZEOLITE_PUBLIC_NAMESPACE { -#endif // ZEOLITE_PUBLIC_NAMESPACE - -S CreateValue_RawFileReader(S parent, const ParamTuple& params, const ValueTuple& args); - -struct ExtCategory_RawFileReader : public Category_RawFileReader { -}; - -struct ExtType_RawFileReader : public Type_RawFileReader { - inline ExtType_RawFileReader(Category_RawFileReader& p, Params<0>::Type params) : Type_RawFileReader(p, params) {} - - ReturnTuple Call_open(const S& self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileReader.open") - return ReturnTuple(CreateValue_RawFileReader(CreateType_RawFileReader(Params<0>::Type()), ParamTuple(), args)); - } -}; - -struct ExtValue_RawFileReader : public Value_RawFileReader { - inline ExtValue_RawFileReader(S p, const ParamTuple& params, const ValueTuple& args) - : Value_RawFileReader(p, params), - filename(args.At(0)->AsString()), - file(new std::ifstream(filename, std::ios::in | std::ios::binary)) {} - - ReturnTuple Call_freeResource(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileReader.freeResource") - std::lock_guard lock(mutex); - if (file) { - file = nullptr; - } - return ReturnTuple(); - } - - ReturnTuple Call_getFileError(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileReader.getFileError") - std::lock_guard lock(mutex); - if (!file) { - return ReturnTuple(Box_String(PrimString_FromLiteral("file has already been closed"))); - } - if (file->rdstate() & std::ios::badbit) { - return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be read or opened"))); - } - if (file->rdstate() & std::ios::failbit) { - return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be read or opened"))); - } - return ReturnTuple(Var_empty); - } - - ReturnTuple Call_pastEnd(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileReader.pastEnd") - std::lock_guard lock(mutex); - return ReturnTuple(Box_Bool(!file || file->fail() || file->eof())); - } - - ReturnTuple Call_readBlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileReader.readBlock") - TRACE_CREATION - std::lock_guard lock(mutex); - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - if (Var_arg1 < 0) { - FAIL() << "Read size " << Var_arg1 << " is invalid"; - } - if (!file || file->rdstate() != std::ios::goodbit) { - FAIL() << "Error reading file \"" << filename << "\""; - } - std::string buffer(Var_arg1, '\x00'); - int read_size = 0; - if (file) { - const bool eof = file->eof(); - if (!eof && !file->fail()) { - file->read(&buffer[0], Var_arg1); - read_size = file->gcount(); - if (file->fail()) { - // Clear an EOF-related error, since we can't tell if it's because the - // file ended or because of a real error. - file->clear(); - file->setstate(std::ios::eofbit); - } - } - } - return ReturnTuple(Box_String(buffer.substr(0, read_size))); - } - - std::mutex mutex; - const std::string filename; - R file; - CAPTURE_CREATION -}; - -Category_RawFileReader& CreateCategory_RawFileReader() { - static auto& category = *new ExtCategory_RawFileReader(); - return category; -} -S CreateType_RawFileReader(Params<0>::Type params) { - static const auto cached = S_get(new ExtType_RawFileReader(CreateCategory_RawFileReader(), Params<0>::Type())); - return cached; -} -S CreateValue_RawFileReader(S parent, const ParamTuple& params, const ValueTuple& args) { - return S_get(new ExtValue_RawFileReader(parent, params, args)); -} - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -} // namespace ZEOLITE_PUBLIC_NAMESPACE -using namespace ZEOLITE_PUBLIC_NAMESPACE; -#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/file/Extension_RawFileWriter.cpp b/lib/file/Extension_RawFileWriter.cpp deleted file mode 100644 --- a/lib/file/Extension_RawFileWriter.cpp +++ /dev/null @@ -1,110 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2020-2021 Kevin P. Barry -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - http://www.apache.org/licenses/LICENSE-2.0 -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -#include -#include - -#include "category-source.hpp" -#include "Streamlined_RawFileWriter.hpp" -#include "Category_Formatted.hpp" -#include "Category_String.hpp" - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -namespace ZEOLITE_PUBLIC_NAMESPACE { -#endif // ZEOLITE_PUBLIC_NAMESPACE - -S CreateValue_RawFileWriter(S parent, const ParamTuple& params, const ValueTuple& args); - -struct ExtCategory_RawFileWriter : public Category_RawFileWriter { -}; - -struct ExtType_RawFileWriter : public Type_RawFileWriter { - inline ExtType_RawFileWriter(Category_RawFileWriter& p, Params<0>::Type params) : Type_RawFileWriter(p, params) {} - - ReturnTuple Call_open(const S& self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileWriter.open") - return ReturnTuple(CreateValue_RawFileWriter(CreateType_RawFileWriter(Params<0>::Type()), ParamTuple(), args)); - } -}; - -struct ExtValue_RawFileWriter : public Value_RawFileWriter { - inline ExtValue_RawFileWriter(S p, const ParamTuple& params, const ValueTuple& args) - : Value_RawFileWriter(p, params), - filename(args.At(0)->AsString()), - file(new std::ofstream(filename, std::ios::out | std::ios::binary | std::ios::trunc | std::ios::ate)) {} - - ReturnTuple Call_freeResource(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileWriter.freeResource") - std::lock_guard lock(mutex); - if (file) { - file = nullptr; - } - return ReturnTuple(); - } - - ReturnTuple Call_getFileError(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileWriter.getFileError") - std::lock_guard lock(mutex); - if (!file) { - return ReturnTuple(Box_String(PrimString_FromLiteral("file has already been closed"))); - } - if (file->rdstate() & std::ios::badbit) { - return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be written or opened"))); - } - if (file->rdstate() & std::ios::failbit) { - return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be written or opened"))); - } - return ReturnTuple(Var_empty); - } - - ReturnTuple Call_writeBlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("RawFileWriter.writeBlock") - TRACE_CREATION - std::lock_guard lock(mutex); - const PrimString& Var_arg1 = args.At(0)->AsString(); - if (!file || file->rdstate() != std::ios::goodbit) { - FAIL() << "Error writing file \"" << filename << "\""; - } - int write_size = 0; - if (file) { - file->write(&Var_arg1[0], Var_arg1.size()); - file->flush(); - write_size = file->fail()? 0 : Var_arg1.size(); - } - return ReturnTuple(Box_Int(write_size)); - } - - std::mutex mutex; - const std::string filename; - R file; - CAPTURE_CREATION -}; - -Category_RawFileWriter& CreateCategory_RawFileWriter() { - static auto& category = *new ExtCategory_RawFileWriter(); - return category; -} -S CreateType_RawFileWriter(Params<0>::Type params) { - static const auto cached = S_get(new ExtType_RawFileWriter(CreateCategory_RawFileWriter(), Params<0>::Type())); - return cached; -} -S CreateValue_RawFileWriter(S parent, const ParamTuple& params, const ValueTuple& args) { - return S_get(new ExtValue_RawFileWriter(parent, params, args)); -} - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -} // namespace ZEOLITE_PUBLIC_NAMESPACE -using namespace ZEOLITE_PUBLIC_NAMESPACE; -#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/file/README.md b/lib/file/README.md new file mode 100644 --- /dev/null +++ b/lib/file/README.md @@ -0,0 +1,12 @@ +# [Zeolite File Library](https://github.com/ta0kira/zeolite/tree/master/lib/file) + +## Library Usage + +- See filenames ending in `.0rp` for documentation. + +- Include `"lib/file"` in `public_deps` or `private_deps` in your + `.zeolite-module`. + +## Configuring and Building + +This library is automatically built by `zeolite-setup`. diff --git a/lib/file/file.0rp b/lib/file/file.0rp --- a/lib/file/file.0rp +++ b/lib/file/file.0rp @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- -Copyright 2020 Kevin P. Barry +Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -16,18 +16,24 @@ // Author: Kevin P. Barry [ta0kira@gmail.com] +// Raw character reading from a file. concrete RawFileReader { refines PersistentResource refines BlockReader + // Open the file. Check getFileError() to see if there is an error. @type open (String) -> (RawFileReader) + // Return an error opening or reading the file, if any. @value getFileError () -> (optional String) } +// Raw character writing to a file. concrete RawFileWriter { refines PersistentResource refines BlockWriter + // Open the file. Check getFileError() to see if there is an error. @type open (String) -> (RawFileWriter) + // Return an error opening or writing the file, if any. @value getFileError () -> (optional String) } diff --git a/lib/file/helpers.0rp b/lib/file/helpers.0rp --- a/lib/file/helpers.0rp +++ b/lib/file/helpers.0rp @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- -Copyright 2020 Kevin P. Barry +Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -18,6 +18,8 @@ $TestsOnly$ +// File helpers for use in unit tests. concrete FileTesting { + // Read the entire file. Crashes if there is an error. @type forceReadFile (String) -> (String) } diff --git a/lib/file/src/Extension_RawFileReader.cpp b/lib/file/src/Extension_RawFileReader.cpp new file mode 100644 --- /dev/null +++ b/lib/file/src/Extension_RawFileReader.cpp @@ -0,0 +1,128 @@ +/* ----------------------------------------------------------------------------- +Copyright 2020-2021 Kevin P. Barry +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + http://www.apache.org/licenses/LICENSE-2.0 +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include +#include + +#include "category-source.hpp" +#include "Streamlined_RawFileReader.hpp" +#include "Category_Formatted.hpp" +#include "Category_String.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +S CreateValue_RawFileReader(S parent, const ParamTuple& params, const ValueTuple& args); + +struct ExtCategory_RawFileReader : public Category_RawFileReader { +}; + +struct ExtType_RawFileReader : public Type_RawFileReader { + inline ExtType_RawFileReader(Category_RawFileReader& p, Params<0>::Type params) : Type_RawFileReader(p, params) {} + + ReturnTuple Call_open(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileReader.open") + return ReturnTuple(CreateValue_RawFileReader(CreateType_RawFileReader(Params<0>::Type()), ParamTuple(), args)); + } +}; + +struct ExtValue_RawFileReader : public Value_RawFileReader { + inline ExtValue_RawFileReader(S p, const ParamTuple& params, const ValueTuple& args) + : Value_RawFileReader(p, params), + filename(args.At(0)->AsString()), + file(new std::ifstream(filename, std::ios::in | std::ios::binary)) {} + + ReturnTuple Call_freeResource(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileReader.freeResource") + std::lock_guard lock(mutex); + if (file) { + file = nullptr; + } + return ReturnTuple(); + } + + ReturnTuple Call_getFileError(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileReader.getFileError") + std::lock_guard lock(mutex); + if (!file) { + return ReturnTuple(Box_String(PrimString_FromLiteral("file has already been closed"))); + } + if (file->rdstate() & std::ios::badbit) { + return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be read or opened"))); + } + if (file->rdstate() & std::ios::failbit) { + return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be read or opened"))); + } + return ReturnTuple(Var_empty); + } + + ReturnTuple Call_pastEnd(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileReader.pastEnd") + std::lock_guard lock(mutex); + return ReturnTuple(Box_Bool(!file || file->fail() || file->eof())); + } + + ReturnTuple Call_readBlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileReader.readBlock") + TRACE_CREATION + std::lock_guard lock(mutex); + const PrimInt Var_arg1 = (args.At(0))->AsInt(); + if (Var_arg1 < 0) { + FAIL() << "Read size " << Var_arg1 << " is invalid"; + } + if (!file || file->rdstate() != std::ios::goodbit) { + FAIL() << "Error reading file \"" << filename << "\""; + } + std::string buffer(Var_arg1, '\x00'); + int read_size = 0; + if (file) { + const bool eof = file->eof(); + if (!eof && !file->fail()) { + file->read(&buffer[0], Var_arg1); + read_size = file->gcount(); + if (file->fail()) { + // Clear an EOF-related error, since we can't tell if it's because the + // file ended or because of a real error. + file->clear(); + file->setstate(std::ios::eofbit); + } + } + } + return ReturnTuple(Box_String(buffer.substr(0, read_size))); + } + + std::mutex mutex; + const std::string filename; + R file; + CAPTURE_CREATION +}; + +Category_RawFileReader& CreateCategory_RawFileReader() { + static auto& category = *new ExtCategory_RawFileReader(); + return category; +} +S CreateType_RawFileReader(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_RawFileReader(CreateCategory_RawFileReader(), Params<0>::Type())); + return cached; +} +S CreateValue_RawFileReader(S parent, const ParamTuple& params, const ValueTuple& args) { + return S_get(new ExtValue_RawFileReader(parent, params, args)); +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/file/src/Extension_RawFileWriter.cpp b/lib/file/src/Extension_RawFileWriter.cpp new file mode 100644 --- /dev/null +++ b/lib/file/src/Extension_RawFileWriter.cpp @@ -0,0 +1,110 @@ +/* ----------------------------------------------------------------------------- +Copyright 2020-2021 Kevin P. Barry +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + http://www.apache.org/licenses/LICENSE-2.0 +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include +#include + +#include "category-source.hpp" +#include "Streamlined_RawFileWriter.hpp" +#include "Category_Formatted.hpp" +#include "Category_String.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +S CreateValue_RawFileWriter(S parent, const ParamTuple& params, const ValueTuple& args); + +struct ExtCategory_RawFileWriter : public Category_RawFileWriter { +}; + +struct ExtType_RawFileWriter : public Type_RawFileWriter { + inline ExtType_RawFileWriter(Category_RawFileWriter& p, Params<0>::Type params) : Type_RawFileWriter(p, params) {} + + ReturnTuple Call_open(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileWriter.open") + return ReturnTuple(CreateValue_RawFileWriter(CreateType_RawFileWriter(Params<0>::Type()), ParamTuple(), args)); + } +}; + +struct ExtValue_RawFileWriter : public Value_RawFileWriter { + inline ExtValue_RawFileWriter(S p, const ParamTuple& params, const ValueTuple& args) + : Value_RawFileWriter(p, params), + filename(args.At(0)->AsString()), + file(new std::ofstream(filename, std::ios::out | std::ios::binary | std::ios::trunc | std::ios::ate)) {} + + ReturnTuple Call_freeResource(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileWriter.freeResource") + std::lock_guard lock(mutex); + if (file) { + file = nullptr; + } + return ReturnTuple(); + } + + ReturnTuple Call_getFileError(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileWriter.getFileError") + std::lock_guard lock(mutex); + if (!file) { + return ReturnTuple(Box_String(PrimString_FromLiteral("file has already been closed"))); + } + if (file->rdstate() & std::ios::badbit) { + return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be written or opened"))); + } + if (file->rdstate() & std::ios::failbit) { + return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be written or opened"))); + } + return ReturnTuple(Var_empty); + } + + ReturnTuple Call_writeBlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("RawFileWriter.writeBlock") + TRACE_CREATION + std::lock_guard lock(mutex); + const PrimString& Var_arg1 = args.At(0)->AsString(); + if (!file || file->rdstate() != std::ios::goodbit) { + FAIL() << "Error writing file \"" << filename << "\""; + } + int write_size = 0; + if (file) { + file->write(&Var_arg1[0], Var_arg1.size()); + file->flush(); + write_size = file->fail()? 0 : Var_arg1.size(); + } + return ReturnTuple(Box_Int(write_size)); + } + + std::mutex mutex; + const std::string filename; + R file; + CAPTURE_CREATION +}; + +Category_RawFileWriter& CreateCategory_RawFileWriter() { + static auto& category = *new ExtCategory_RawFileWriter(); + return category; +} +S CreateType_RawFileWriter(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_RawFileWriter(CreateCategory_RawFileWriter(), Params<0>::Type())); + return cached; +} +S CreateValue_RawFileWriter(S parent, const ParamTuple& params, const ValueTuple& args) { + return S_get(new ExtValue_RawFileWriter(parent, params, args)); +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/file/tests.0rt b/lib/file/tests.0rt --- a/lib/file/tests.0rt +++ b/lib/file/tests.0rt @@ -32,7 +32,7 @@ fail(require(writer.getFileError())) } Int writeSize <- writer.writeBlock(data) - if (writeSize != data.readSize()) { + if (writeSize != data.size()) { fail(writeSize) } if (present(writer.getFileError())) { diff --git a/lib/math/.zeolite-module b/lib/math/.zeolite-module --- a/lib/math/.zeolite-module +++ b/lib/math/.zeolite-module @@ -5,7 +5,7 @@ ] extra_files: [ category_source { - source: "lib/math/Extension_Math.cpp" + source: "lib/math/src/Extension_Math.cpp" categories: [Math] } ] diff --git a/lib/math/Extension_Math.cpp b/lib/math/Extension_Math.cpp deleted file mode 100644 --- a/lib/math/Extension_Math.cpp +++ /dev/null @@ -1,217 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2020-2021 Kevin P. Barry - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -#include - -#include "category-source.hpp" -#include "Streamlined_Math.hpp" -#include "Category_Formatted.hpp" -#include "Category_String.hpp" - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -namespace ZEOLITE_PUBLIC_NAMESPACE { -#endif // ZEOLITE_PUBLIC_NAMESPACE - -struct ExtCategory_Math : public Category_Math { -}; - -struct ExtType_Math : public Type_Math { - inline ExtType_Math(Category_Math& p, Params<0>::Type params) : Type_Math(p, params) {} - - ReturnTuple Call_acos(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.acos") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::acos(Var_arg1))); - } - - ReturnTuple Call_acosh(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.acosh") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::acosh(Var_arg1))); - } - - ReturnTuple Call_asin(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.asin") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::asin(Var_arg1))); - } - - ReturnTuple Call_asinh(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.asinh") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::asinh(Var_arg1))); - } - - ReturnTuple Call_atan(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.atan") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::atan(Var_arg1))); - } - - ReturnTuple Call_atanh(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.atanh") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::atanh(Var_arg1))); - } - - ReturnTuple Call_ceil(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.ceil") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::ceil(Var_arg1))); - } - - ReturnTuple Call_cos(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.cos") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::cos(Var_arg1))); - } - - ReturnTuple Call_cosh(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.cosh") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::cosh(Var_arg1))); - } - - ReturnTuple Call_exp(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.exp") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::exp(Var_arg1))); - } - - ReturnTuple Call_fabs(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.fabs") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::fabs(Var_arg1))); - } - - ReturnTuple Call_floor(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.floor") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::floor(Var_arg1))); - } - - ReturnTuple Call_fmod(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.fmod") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - const PrimFloat Var_arg2 = (args.At(1))->AsFloat(); - return ReturnTuple(Box_Float(std::fmod(Var_arg1,Var_arg2))); - } - - ReturnTuple Call_isinf(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.isinf") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Bool(std::isinf(Var_arg1))); - } - - ReturnTuple Call_isnan(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.isnan") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Bool(std::isnan(Var_arg1))); - } - - ReturnTuple Call_log(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.log") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::log(Var_arg1))); - } - - ReturnTuple Call_log10(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.log10") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::log10(Var_arg1))); - } - - ReturnTuple Call_log2(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.log2") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::log2(Var_arg1))); - } - - ReturnTuple Call_pow(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.pow") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - const PrimFloat Var_arg2 = (args.At(1))->AsFloat(); - return ReturnTuple(Box_Float(std::pow(Var_arg1,Var_arg2))); - } - - ReturnTuple Call_round(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.round") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::round(Var_arg1))); - } - - ReturnTuple Call_sin(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.sin") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::sin(Var_arg1))); - } - - ReturnTuple Call_sinh(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.sinh") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::sinh(Var_arg1))); - } - - ReturnTuple Call_sqrt(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.sqrt") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::sqrt(Var_arg1))); - } - - ReturnTuple Call_tan(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.tan") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::tan(Var_arg1))); - } - - ReturnTuple Call_tanh(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.tanh") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::tanh(Var_arg1))); - } - - ReturnTuple Call_trunc(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.trunc") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - return ReturnTuple(Box_Float(std::trunc(Var_arg1))); - } - - ReturnTuple Call_abs(const S& self, const ParamTuple& params, const ValueTuple& args) final { - TRACE_FUNCTION("Math.abs") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - return ReturnTuple(Box_Int(std::abs(Var_arg1))); - } -}; - -struct ExtValue_Math : public Value_Math { - inline ExtValue_Math(S p, const ParamTuple& params, const ValueTuple& args) : Value_Math(p, params) {} -}; - -Category_Math& CreateCategory_Math() { - static auto& category = *new ExtCategory_Math(); - return category; -} -S CreateType_Math(Params<0>::Type params) { - static const auto cached = S_get(new ExtType_Math(CreateCategory_Math(), Params<0>::Type())); - return cached; -} - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -} // namespace ZEOLITE_PUBLIC_NAMESPACE -using namespace ZEOLITE_PUBLIC_NAMESPACE; -#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/math/README.md b/lib/math/README.md new file mode 100644 --- /dev/null +++ b/lib/math/README.md @@ -0,0 +1,11 @@ +# [Zeolite Math Library](https://github.com/ta0kira/zeolite/tree/master/lib/math) + +## Library Usage + +- See filenames ending in `.0rp` for documentation. + +- Include `"lib/math"` in `private_deps` in your `.zeolite-module`. + +## Configuring and Building + +This library is automatically built by `zeolite-setup`. diff --git a/lib/math/math.0rp b/lib/math/math.0rp --- a/lib/math/math.0rp +++ b/lib/math/math.0rp @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- -Copyright 2020 Kevin P. Barry +Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -16,6 +16,7 @@ // Author: Kevin P. Barry [ta0kira@gmail.com] +// Standard numerical functions from C++. concrete Math { @type cos (Float) -> (Float) @type sin (Float) -> (Float) diff --git a/lib/math/src/Extension_Math.cpp b/lib/math/src/Extension_Math.cpp new file mode 100644 --- /dev/null +++ b/lib/math/src/Extension_Math.cpp @@ -0,0 +1,217 @@ +/* ----------------------------------------------------------------------------- +Copyright 2020-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include + +#include "category-source.hpp" +#include "Streamlined_Math.hpp" +#include "Category_Formatted.hpp" +#include "Category_String.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +struct ExtCategory_Math : public Category_Math { +}; + +struct ExtType_Math : public Type_Math { + inline ExtType_Math(Category_Math& p, Params<0>::Type params) : Type_Math(p, params) {} + + ReturnTuple Call_acos(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.acos") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::acos(Var_arg1))); + } + + ReturnTuple Call_acosh(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.acosh") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::acosh(Var_arg1))); + } + + ReturnTuple Call_asin(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.asin") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::asin(Var_arg1))); + } + + ReturnTuple Call_asinh(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.asinh") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::asinh(Var_arg1))); + } + + ReturnTuple Call_atan(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.atan") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::atan(Var_arg1))); + } + + ReturnTuple Call_atanh(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.atanh") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::atanh(Var_arg1))); + } + + ReturnTuple Call_ceil(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.ceil") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::ceil(Var_arg1))); + } + + ReturnTuple Call_cos(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.cos") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::cos(Var_arg1))); + } + + ReturnTuple Call_cosh(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.cosh") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::cosh(Var_arg1))); + } + + ReturnTuple Call_exp(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.exp") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::exp(Var_arg1))); + } + + ReturnTuple Call_fabs(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.fabs") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::fabs(Var_arg1))); + } + + ReturnTuple Call_floor(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.floor") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::floor(Var_arg1))); + } + + ReturnTuple Call_fmod(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.fmod") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + const PrimFloat Var_arg2 = (args.At(1))->AsFloat(); + return ReturnTuple(Box_Float(std::fmod(Var_arg1,Var_arg2))); + } + + ReturnTuple Call_isinf(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.isinf") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Bool(std::isinf(Var_arg1))); + } + + ReturnTuple Call_isnan(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.isnan") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Bool(std::isnan(Var_arg1))); + } + + ReturnTuple Call_log(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.log") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::log(Var_arg1))); + } + + ReturnTuple Call_log10(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.log10") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::log10(Var_arg1))); + } + + ReturnTuple Call_log2(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.log2") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::log2(Var_arg1))); + } + + ReturnTuple Call_pow(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.pow") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + const PrimFloat Var_arg2 = (args.At(1))->AsFloat(); + return ReturnTuple(Box_Float(std::pow(Var_arg1,Var_arg2))); + } + + ReturnTuple Call_round(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.round") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::round(Var_arg1))); + } + + ReturnTuple Call_sin(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.sin") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::sin(Var_arg1))); + } + + ReturnTuple Call_sinh(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.sinh") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::sinh(Var_arg1))); + } + + ReturnTuple Call_sqrt(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.sqrt") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::sqrt(Var_arg1))); + } + + ReturnTuple Call_tan(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.tan") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::tan(Var_arg1))); + } + + ReturnTuple Call_tanh(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.tanh") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::tanh(Var_arg1))); + } + + ReturnTuple Call_trunc(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.trunc") + const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + return ReturnTuple(Box_Float(std::trunc(Var_arg1))); + } + + ReturnTuple Call_abs(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Math.abs") + const PrimInt Var_arg1 = (args.At(0))->AsInt(); + return ReturnTuple(Box_Int(std::abs(Var_arg1))); + } +}; + +struct ExtValue_Math : public Value_Math { + inline ExtValue_Math(S p, const ParamTuple& params, const ValueTuple& args) : Value_Math(p, params) {} +}; + +Category_Math& CreateCategory_Math() { + static auto& category = *new ExtCategory_Math(); + return category; +} +S CreateType_Math(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_Math(CreateCategory_Math(), Params<0>::Type())); + return cached; +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/testing/.zeolite-module b/lib/testing/.zeolite-module --- a/lib/testing/.zeolite-module +++ b/lib/testing/.zeolite-module @@ -1,3 +1,3 @@ -root: ".." -path: "testing" +root: "../.." +path: "lib/testing" mode: incremental {} diff --git a/lib/testing/README.md b/lib/testing/README.md new file mode 100644 --- /dev/null +++ b/lib/testing/README.md @@ -0,0 +1,13 @@ +# [Zeolite Testing Library](https://github.com/ta0kira/zeolite/tree/master/lib/testing) + +## Library Usage + +- See filenames ending in `.0rp` for documentation. + +- This library is only for use in tests in `.0rt` files. + +- Include `"lib/testing"` in `private_deps` in your `.zeolite-module`. + +## Configuring and Building + +This library is automatically built by `zeolite-setup`. diff --git a/lib/testing/helpers.0rp b/lib/testing/helpers.0rp --- a/lib/testing/helpers.0rp +++ b/lib/testing/helpers.0rp @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- -Copyright 2020 Kevin P. Barry +Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -18,15 +18,32 @@ $TestsOnly$ +// General helpers for use in unit tests. concrete Testing { + // Check the values for equality. Crashes if they are not equal. + // + // Args: + // - #x: Actual value. + // - #x: Expected value. @type checkEquals<#x> #x requires Formatted #x defines Equals<#x> - (#x /*actual*/, #x /*expected*/) -> () + (#x,#x) -> () + // Check that the value is within a range. Crashes if they are not equal. + // + // Args: + // - #x: Actual value. + // - #x: Lower bound. + // - #x: Upper bound. + // + // Notes: + // - This could be done without Equals, except that some types have + // "undefined" values (e.g., NaN, for Float) that prevent inferring equality + // from less-than comparisons. @type checkBetween<#x> #x requires Formatted #x defines Equals<#x> #x defines LessThan<#x> - (#x /*actual*/, #x /*lower*/, #x /*upper*/) -> () + (#x,#x,#x) -> () } diff --git a/lib/thread/.zeolite-module b/lib/thread/.zeolite-module new file mode 100644 --- /dev/null +++ b/lib/thread/.zeolite-module @@ -0,0 +1,25 @@ +root: "../.." +path: "lib/thread" +public_deps: [ + "lib/util" +] +private_deps: [ + "lib/testing" +] +extra_files: [ + category_source { + source: "lib/thread/src/Extension_MutexLock.cpp" + categories: [MutexLock] + } + category_source { + source: "lib/thread/src/Extension_ProcessThread.cpp" + categories: [ProcessThread] + } + category_source { + source: "lib/thread/src/Extension_SimpleMutex.cpp" + categories: [SimpleMutex] + } +] +mode: incremental { + link_flags: ["-lpthread"] +} diff --git a/lib/thread/README.md b/lib/thread/README.md new file mode 100644 --- /dev/null +++ b/lib/thread/README.md @@ -0,0 +1,35 @@ +# [Zeolite Thread Library](https://github.com/ta0kira/zeolite/tree/master/lib/thread) + +## Library Usage + +- See filenames ending in `.0rp` for documentation. + +- Include `"lib/thread"` in `public_deps` or `private_deps` in your + `.zeolite-module`. + +## Configuring and Building + +This library *is not* automatically built by `zeolite-setup`; you need to build +it manually. This is because there might be issues with linker dependencies +between different systems. + +1. If you are running Linux, the config should work as-is. If you are running + FreeBSD, you might need to remove or change `"-lpthread"` at the bottom of + `.zeolite-module`. + + To build the library: + + ```shell + ZEOLITE_PATH=$(zeolite --get-path) + zeolite -p "$ZEOLITE_PATH" -r lib/thread + ``` + +2. Even if the library builds without errors, you should still run the tests to + ensure that the linker flags are correct. + + ```shell + zeolite -p "$ZEOLITE_PATH" -t lib/thread + ``` + + If you run into linker errors, you might need to go to step 1 and update the + `link_flags` in `.zeolite-module`. diff --git a/lib/thread/mutex.0rp b/lib/thread/mutex.0rp new file mode 100644 --- /dev/null +++ b/lib/thread/mutex.0rp @@ -0,0 +1,63 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// A blocking mutex. +// +// Notes: +// - Most use-cases should use MutexLock instead of explicit calls to lock() and +// unlock(), to mitigate the risk of deadlocks. +@value interface Mutex { + // Lock the mutex. + lock () -> (#self) + + // Unlock the mutex. + unlock () -> (#self) +} + +// A simple mutex with no deadlock prevention. +concrete SimpleMutex { + refines Mutex + + // Create a new mutex. + @type new () -> (Mutex) +} + +// An automatic mutex lock. +// +// Notes: +// - freeResource() must be called; otherwise, there will be a crash. This is to +// catch code that could cause a deadlock. +// - freeResource() must only be called once per MutexLock. +// +// Example: +// +// scoped { +// MutexLock lock <- MutexLock.lock(myMutex) +// $Hidden[myMutex]$ // Hide the mutex to prevent further locking attempts. +// } cleanup { +// \ lock.freeResource() +// } in { +// $Hidden[lock]$ // Nothing else needs to see the lock. +// // your code +// } +concrete MutexLock { + refines PersistentResource + + // Create a new lock and lock the Mutex. + @type lock (Mutex) -> (MutexLock) +} diff --git a/lib/thread/mutex.0rt b/lib/thread/mutex.0rt new file mode 100644 --- /dev/null +++ b/lib/thread/mutex.0rt @@ -0,0 +1,138 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "MutexLock crashes if not freed" { + crash + require "not freed" +} + +unittest test { + Mutex mutex <- SimpleMutex.new() + \ MutexLock.lock(mutex) +} + + +testcase "MutexLock crashes if freed twice" { + crash + require "freed multiple times" +} + +unittest test { + Mutex mutex <- SimpleMutex.new() + MutexLock lock <- MutexLock.lock(mutex) + \ lock.freeResource() + \ lock.freeResource() +} + + +testcase "mutex integration test" { + success +} + +unittest test { + Mutex mutex <- SimpleMutex.new() + Value value <- Value.create() + Thread evenThread <- ProcessThread.from(EvenOrOdd.create(mutex,true, 10,value)).start() + Thread oddThread <- ProcessThread.from(EvenOrOdd.create(mutex,false,10,value)).start() + \ evenThread.join() + \ oddThread.join() + \ Testing.checkEquals(value.get(),20) +} + +concrete EvenOrOdd { + refines Routine + + // Args: + // - Mutex: Locks the Value. + // - Bool: Increment only on even if true, or on odd if false. + // - Int: Number of increment operations. + // - Value: Value to increment. + @type create (Mutex,Bool,Int,Value) -> (Routine) +} + +define EvenOrOdd { + @value Mutex mutex + @value Bool even + @value Int count + @value Value value + + create (m,e,c,v) { + return EvenOrOdd{ m, e, c, v } + } + + run () { + scoped { + Int i <- 0 + } in while (i < count) { + $Hidden[count]$ + scoped { + MutexLock lock <- MutexLock.lock(mutex) + $Hidden[mutex]$ + if (value.getInUse()) { + fail("value in use") + } else { + \ value.setInUse(true) + } + } cleanup { + \ value.setInUse(false) + \ lock.freeResource() + } in { + $Hidden[lock]$ + if ((value.get()%2 == 0) ^ !even) { + i <- i+1 + \ value.increment() + } + } + } + } +} + +concrete Value { + @type create () -> (Value) + + @value get () -> (Int) + @value increment () -> () + + @value setInUse (Bool) -> () + @value getInUse () -> (Bool) +} + +define Value { + @value Int value + @value Bool inUse + + create () { + return Value{ 0, false } + } + + get () { + return value + } + + increment () { + value <- value+1 + } + + setInUse (i) { + inUse <- i + } + + getInUse () { + return inUse + } +} diff --git a/lib/thread/src/Extension_MutexLock.cpp b/lib/thread/src/Extension_MutexLock.cpp new file mode 100644 --- /dev/null +++ b/lib/thread/src/Extension_MutexLock.cpp @@ -0,0 +1,91 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include + +#include "category-source.hpp" +#include "Streamlined_MutexLock.hpp" +#include "Category_Mutex.hpp" +#include "Category_MutexLock.hpp" +#include "Category_PersistentResource.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +S CreateValue_MutexLock(S parent, const ParamTuple& params, const ValueTuple& args); + +struct ExtCategory_MutexLock : public Category_MutexLock { +}; + +struct ExtType_MutexLock : public Type_MutexLock { + inline ExtType_MutexLock(Category_MutexLock& p, Params<0>::Type params) : Type_MutexLock(p, params) {} + + ReturnTuple Call_lock(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("MutexLock.lock") + return ReturnTuple(CreateValue_MutexLock(CreateType_MutexLock(Params<0>::Type()), ParamTuple(), args)); + } +}; + +struct ExtValue_MutexLock : public Value_MutexLock { + inline ExtValue_MutexLock(S p, const ParamTuple& params, const ValueTuple& args) + : Value_MutexLock(p, params), mutex(args.Only()) { + TypeValue::Call(mutex, Function_Mutex_lock, ParamTuple(), ArgTuple()); + } + + ReturnTuple Call_freeResource(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("PersistentResource.freeResource") + TRACE_CREATION + if (!mutex) { + FAIL() << "MutexLock freed multiple times"; + } else { + TypeValue::Call(mutex, Function_Mutex_unlock, ParamTuple(), ArgTuple()); + mutex = nullptr; + } + return ReturnTuple(); + } + + ~ExtValue_MutexLock() { + if (mutex) { + TRACE_CREATION + TypeValue::Call(mutex, Function_Mutex_unlock, ParamTuple(), ArgTuple()); + mutex = nullptr; + FAIL() << "MutexLock not freed with freeResource()"; + } + } + + S mutex; + CAPTURE_CREATION +}; + +Category_MutexLock& CreateCategory_MutexLock() { + static auto& category = *new ExtCategory_MutexLock(); + return category; +} +S CreateType_MutexLock(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_MutexLock(CreateCategory_MutexLock(), Params<0>::Type())); + return cached; +} +S CreateValue_MutexLock(S parent, const ParamTuple& params, const ValueTuple& args) { + return S_get(new ExtValue_MutexLock(parent, params, args)); +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/thread/src/Extension_ProcessThread.cpp b/lib/thread/src/Extension_ProcessThread.cpp new file mode 100644 --- /dev/null +++ b/lib/thread/src/Extension_ProcessThread.cpp @@ -0,0 +1,130 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include +#include + +#include "category-source.hpp" +#include "Streamlined_ProcessThread.hpp" +#include "Category_Bool.hpp" +#include "Category_Process.hpp" +#include "Category_ProcessThread.hpp" +#include "Category_Routine.hpp" +#include "Category_Thread.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +S CreateValue_ProcessThread(S parent, const ParamTuple& params, const ValueTuple& args); + +struct ExtCategory_ProcessThread : public Category_ProcessThread { +}; + +struct ExtType_ProcessThread : public Type_ProcessThread { + inline ExtType_ProcessThread(Category_ProcessThread& p, Params<0>::Type params) : Type_ProcessThread(p, params) {} + + ReturnTuple Call_from(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("ProcessThread.from") + return ReturnTuple(CreateValue_ProcessThread(CreateType_ProcessThread(Params<0>::Type()), params, args)); + } +}; + +struct ExtValue_ProcessThread : public Value_ProcessThread { + inline ExtValue_ProcessThread(S p, const ParamTuple& params, const ValueTuple& args) + : Value_ProcessThread(p, params), routine(args.Only()) {} + + ReturnTuple Call_detach(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Thread.detach") + S temp = thread; + thread = nullptr; + if (!isJoinable(temp.get())) { + FAIL() << "thread has not been started"; + } else { + temp->detach(); + } + return ReturnTuple(Var_self); + } + + ReturnTuple Call_isRunning(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Thread.isRunning") + return ReturnTuple(Box_Bool(isJoinable(thread.get()))); + } + + ReturnTuple Call_join(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Thread.join") + S temp = thread; + thread = nullptr; + if (!isJoinable(temp.get())) { + FAIL() << "thread has not been started"; + } else { + temp->join(); + } + return ReturnTuple(Var_self); + } + + ReturnTuple Call_start(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Process.start") + if (isJoinable(thread.get())) { + FAIL() << "thread is already running"; + } else { + // NOTE: Capture Var_self so that the thread retains a reference while + // it's still running. This allows the caller to hold a weak reference to + // the thread. + thread.reset(new std::thread( + [this,Var_self] { + TRACE_CREATION + TypeValue::Call(routine, Function_Routine_run, ParamTuple(), ArgTuple()); + })); + } + return ReturnTuple(Var_self); + } + + inline static bool isJoinable(std::thread* thread) { + return thread && thread->joinable(); + } + + ~ExtValue_ProcessThread() { + S temp = thread; + thread = nullptr; + if (isJoinable(temp.get())) { + thread->detach(); + } + } + + const S routine; + S thread; + CAPTURE_CREATION +}; + +Category_ProcessThread& CreateCategory_ProcessThread() { + static auto& category = *new ExtCategory_ProcessThread(); + return category; +} +S CreateType_ProcessThread(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_ProcessThread(CreateCategory_ProcessThread(), Params<0>::Type())); + return cached; +} +S CreateValue_ProcessThread(S parent, const ParamTuple& params, const ValueTuple& args) { + return S_get(new ExtValue_ProcessThread(parent, params, args)); +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/thread/src/Extension_SimpleMutex.cpp b/lib/thread/src/Extension_SimpleMutex.cpp new file mode 100644 --- /dev/null +++ b/lib/thread/src/Extension_SimpleMutex.cpp @@ -0,0 +1,77 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include + +#include "category-source.hpp" +#include "Streamlined_SimpleMutex.hpp" +#include "Category_Mutex.hpp" +#include "Category_SimpleMutex.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +S CreateValue_SimpleMutex(S parent); + +struct ExtCategory_SimpleMutex : public Category_SimpleMutex { +}; + +struct ExtType_SimpleMutex : public Type_SimpleMutex { + inline ExtType_SimpleMutex(Category_SimpleMutex& p, Params<0>::Type params) : Type_SimpleMutex(p, params) {} + + ReturnTuple Call_new(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleMutex.new") + return ReturnTuple(CreateValue_SimpleMutex(CreateType_SimpleMutex(Params<0>::Type()))); + } +}; + +struct ExtValue_SimpleMutex : public Value_SimpleMutex { + inline ExtValue_SimpleMutex(S p, const ParamTuple& params) : Value_SimpleMutex(p, params) {} + + ReturnTuple Call_lock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Mutex.lock") + mutex.lock(); + return ReturnTuple(Var_self); + } + + ReturnTuple Call_unlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Mutex.unlock") + mutex.unlock(); + return ReturnTuple(Var_self); + } + + std::mutex mutex; +}; + +Category_SimpleMutex& CreateCategory_SimpleMutex() { + static auto& category = *new ExtCategory_SimpleMutex(); + return category; +} +S CreateType_SimpleMutex(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_SimpleMutex(CreateCategory_SimpleMutex(), Params<0>::Type())); + return cached; +} +S CreateValue_SimpleMutex(S parent) { + return S_get(new ExtValue_SimpleMutex(parent, ParamTuple())); +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/thread/testing.0rp b/lib/thread/testing.0rp new file mode 100644 --- /dev/null +++ b/lib/thread/testing.0rp @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +$ModuleOnly$ +$TestsOnly$ + +concrete NoOpRoutine { + refines Routine + + @type create () -> (NoOpRoutine) +} diff --git a/lib/thread/testing.0rx b/lib/thread/testing.0rx new file mode 100644 --- /dev/null +++ b/lib/thread/testing.0rx @@ -0,0 +1,27 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +$TestsOnly$ + +define NoOpRoutine { + create () { + return NoOpRoutine{ } + } + + run () {} +} diff --git a/lib/thread/thread.0rp b/lib/thread/thread.0rp new file mode 100644 --- /dev/null +++ b/lib/thread/thread.0rp @@ -0,0 +1,97 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// Handle for a separate thread. +@value interface Thread { + // Returns true iff the thread can be detached or joined. + // + // Notes: + // - If isRunning() returns true, a subsequent call to join() or detach() + // should succeed even if the actual thread process exits before then. + isRunning () -> (Bool) + + // Blocks the current thread until the Thread exits. + // + // Notes: + // - Check isRunning() before calling. There might be a crash otherwise. + join () -> (#self) + + // Disassociates the running thread from this handle. + // + // Notes: + // - Check isRunning() before calling. There might be a crash otherwise. + detach () -> (#self) +} + +// An arbitrary routine that need not terminate. +@value interface Routine { + // Run the routine. + run () -> () +} + +// An arbitrary process. +@value interface Process { + // Start the process. + start () -> (#self) +} + +// A traditional thread. +// +// Notes: +// - If join() or detach() are never explicitly called, the thread will detach +// on its own once there are no more references to it. This prevents the +// thread holding the last reference from blocking. +concrete ProcessThread { + refines Process + refines Thread + + // Create a new thread that runs the routine. + // + // Notes: + // - The thread does not automatically start; call start() when ready. + // - If Routine is self and self holds the Thread as a @value member, it + // should be stored as weak Thread to avoid an ownership cycle. The thread + // will automatically become empty once the routine exits. + // + // Example: + // + // concrete MyRoutine { + // @type createAndRun () -> (MyRoutine) + // } + // + // define MyRoutine { + // refines Routine + // + // @value weak Thread thread + // + // createAndRun () { + // return (MyRoutine{ empty }).start() + // } + // + // run () { + // // routine + // } + // + // @value start () -> (#self) + // start () { + // thread <- ProcessThread.from(self).start() + // return self + // } + // } + @type from (Routine) -> (ProcessThread) +} diff --git a/lib/thread/thread.0rt b/lib/thread/thread.0rt new file mode 100644 --- /dev/null +++ b/lib/thread/thread.0rt @@ -0,0 +1,137 @@ +/* ----------------------------------------------------------------------------- +Copyright 2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "simple Thread test" { + success +} + +unittest test { + Counter counter <- Counter.create(10000) + \ Testing.checkEquals(counter.get(),0) + \ counter.start() + \ Testing.checkEquals(counter.get(),10000) + \ counter.start() + \ Testing.checkEquals(counter.get(),20000) +} + +concrete Counter { + refines Process + + @type create (Int) -> (Counter) + @value get () -> (Int) +} + +define Counter { + refines Routine + + @value Int current + @value Int count + @value weak Thread thread + + create (c) { + return Counter{ 0, c, empty } + } + + start () { + // Starting it right away causes the thread function to take a reference to + // thread. This means that once it exits, thread will become empty. + thread <- ProcessThread.from(self).start() + return self + } + + run () { + scoped { + Int i <- 0 + } in while (i < count) { + current <- current+1 + } update { + i <- i+1 + } + } + + get () { + optional Thread thread2 <- strong(thread) + if (present(thread2)) { + if (!require(thread2).isRunning()) { + fail("thread has not been started yet") + } else { + \ require(thread2).join() + } + } + return current + } +} + + +testcase "join() crashes if Thread not started yet" { + crash + require "thread.*started" +} + +unittest test { + \ ProcessThread.from(NoOpRoutine.create()).join() +} + + +testcase "join() twice crashes" { + crash + require "thread.*started" +} + +unittest test { + \ ProcessThread.from(NoOpRoutine.create()).join().join() +} + + +testcase "detach() crashes if Thread not started yet" { + crash + require "thread.*started" +} + +unittest test { + \ ProcessThread.from(NoOpRoutine.create()).detach() +} + + +testcase "detach() twice crashes" { + crash + require "thread.*started" +} + +unittest test { + \ ProcessThread.from(NoOpRoutine.create()).detach().detach() +} + + +testcase "weak Thread frees on exit" { + success +} + +unittest startAndJoin { + weak Thread thread <- ProcessThread.from(NoOpRoutine.create()).start().join() + if (present(strong(thread))) { + fail("thread is still present") + } +} + +unittest notStarted { + weak Thread thread <- ProcessThread.from(NoOpRoutine.create()) + if (present(strong(thread))) { + fail("thread is still present") + } +} diff --git a/lib/util/.zeolite-module b/lib/util/.zeolite-module --- a/lib/util/.zeolite-module +++ b/lib/util/.zeolite-module @@ -1,5 +1,5 @@ -root: ".." -path: "util" +root: "../.." +path: "lib/util" expression_map: [ expression_macro { name: BLOCK_READ_SIZE @@ -11,15 +11,15 @@ ] extra_files: [ category_source { - source: "util/Extension_Argv.cpp" + source: "lib/util/src/Extension_Argv.cpp" categories: [Argv] } category_source { - source: "util/Extension_SimpleInput.cpp" + source: "lib/util/src/Extension_SimpleInput.cpp" categories: [SimpleInput] } category_source { - source: "util/Extension_SimpleOutput.cpp" + source: "lib/util/src/Extension_SimpleOutput.cpp" categories: [SimpleOutput] } ] diff --git a/lib/util/Extension_Argv.cpp b/lib/util/Extension_Argv.cpp deleted file mode 100644 --- a/lib/util/Extension_Argv.cpp +++ /dev/null @@ -1,96 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2020 Kevin P. Barry -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - http://www.apache.org/licenses/LICENSE-2.0 -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -#include "category-source.hpp" -#include "Streamlined_Argv.hpp" -#include "Category_Formatted.hpp" -#include "Category_String.hpp" - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -namespace ZEOLITE_PUBLIC_NAMESPACE { -#endif // ZEOLITE_PUBLIC_NAMESPACE - -S CreateValue_Argv(S parent, const ParamTuple& params, int st, int sz); - -namespace { -extern const S& Var_global; -} // namespace - -struct ExtCategory_Argv : public Category_Argv { -}; - -struct ExtType_Argv : public Type_Argv { - inline ExtType_Argv(Category_Argv& p, Params<0>::Type params) : Type_Argv(p, params) {} - - ReturnTuple Call_global(const S& self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("Argv.global") - return ReturnTuple(Var_global); - } -}; - -struct ExtValue_Argv : public Value_Argv { - inline ExtValue_Argv(S p, const ParamTuple& params, int st, int sz) - : Value_Argv(p, params), start(st), size(sz) {} - - ReturnTuple Call_readPosition(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("Argv.readPosition") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - return ReturnTuple(Box_String(Argv::GetArgAt(start + Var_arg1))); - } - - ReturnTuple Call_readSize(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("Argv.readSize") - return ReturnTuple(Box_Int(GetSize())); - } - - ReturnTuple Call_subSequence(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("Argv.subSequence") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - const PrimInt Var_arg2 = (args.At(1))->AsInt(); - if (Var_arg1 < 0 || (Var_arg1 > 0 && Var_arg1 >= GetSize())) { - FAIL() << "Subsequence index " << Var_arg1 << " is out of bounds"; - } - if (Var_arg2 < 0 || Var_arg1 + Var_arg2 > GetSize()) { - FAIL() << "Subsequence size " << Var_arg2 << " is invalid"; - } - return ReturnTuple(S(new ExtValue_Argv(parent, ParamTuple(), start + Var_arg1, Var_arg2))); - } - - inline int GetSize() const { return size < 0 ? Argv::ArgCount() : size; } - - const int start; - const int size; -}; - -namespace { -const S& Var_global = *new S(new ExtValue_Argv(CreateType_Argv(Params<0>::Type()), ParamTuple(), 0, -1)); -} // namespace - -Category_Argv& CreateCategory_Argv() { - static auto& category = *new ExtCategory_Argv(); - return category; -} -S CreateType_Argv(Params<0>::Type params) { - static const auto cached = S_get(new ExtType_Argv(CreateCategory_Argv(), Params<0>::Type())); - return cached; -} -S CreateValue_Argv(S parent, const ParamTuple& params, int st, int sz) { - return S_get(new ExtValue_Argv(parent, params, st, sz)); -} - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -} // namespace ZEOLITE_PUBLIC_NAMESPACE -using namespace ZEOLITE_PUBLIC_NAMESPACE; -#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/Extension_SimpleInput.cpp b/lib/util/Extension_SimpleInput.cpp deleted file mode 100644 --- a/lib/util/Extension_SimpleInput.cpp +++ /dev/null @@ -1,90 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2019-2021 Kevin P. Barry -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - http://www.apache.org/licenses/LICENSE-2.0 -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -// TODO: Maybe use C++ instead. -#include - -#include "category-source.hpp" -#include "Streamlined_SimpleInput.hpp" -#include "Category_Formatted.hpp" -#include "Category_String.hpp" - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -namespace ZEOLITE_PUBLIC_NAMESPACE { -#endif // ZEOLITE_PUBLIC_NAMESPACE - -namespace { -extern const S& Var_stdin; -} // namespace - -struct ExtCategory_SimpleInput : public Category_SimpleInput { -}; - -struct ExtType_SimpleInput : public Type_SimpleInput { - inline ExtType_SimpleInput(Category_SimpleInput& p, Params<0>::Type params) : Type_SimpleInput(p, params) {} - - ReturnTuple Call_stdin(const S& self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("SimpleInput.stdin") - return ReturnTuple(Var_stdin); - } -}; - -struct ExtValue_SimpleInput : public Value_SimpleInput { - inline ExtValue_SimpleInput(S p, const ParamTuple& params, const ValueTuple& args) : Value_SimpleInput(p, params) {} - - ReturnTuple Call_pastEnd(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("SimpleInput.pastEnd") - std::lock_guard lock(mutex); - return ReturnTuple(Box_Bool(zero_read)); - } - - ReturnTuple Call_readBlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("SimpleInput.readBlock") - std::lock_guard lock(mutex); - const int size = args.At(0)->AsInt(); - if (size < 0) { - FAIL() << "Read size " << size << " is invalid"; - } - std::string buffer(size, '\x00'); - const int read_size = read(STDIN_FILENO, &buffer[0], size); - if (read_size < 0) { - return ReturnTuple(Box_String("")); - } else { - zero_read = read_size == 0; - return ReturnTuple(Box_String(buffer.substr(0, read_size))); - } - } - - bool zero_read = false; - std::mutex mutex; -}; - -namespace { -const S& Var_stdin = *new S(new ExtValue_SimpleInput(CreateType_SimpleInput(Params<0>::Type()), ParamTuple(), ArgTuple())); -} // namespace - -Category_SimpleInput& CreateCategory_SimpleInput() { - static auto& category = *new ExtCategory_SimpleInput(); - return category; -} -S CreateType_SimpleInput(Params<0>::Type params) { - static const auto cached = S_get(new ExtType_SimpleInput(CreateCategory_SimpleInput(), Params<0>::Type())); - return cached; -} - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -} // namespace ZEOLITE_PUBLIC_NAMESPACE -using namespace ZEOLITE_PUBLIC_NAMESPACE; -#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/Extension_SimpleOutput.cpp b/lib/util/Extension_SimpleOutput.cpp deleted file mode 100644 --- a/lib/util/Extension_SimpleOutput.cpp +++ /dev/null @@ -1,136 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2019-2021 Kevin P. Barry -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - http://www.apache.org/licenses/LICENSE-2.0 -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -#include -#include -#include - -#include "category-source.hpp" -#include "Streamlined_SimpleOutput.hpp" -#include "Category_Formatted.hpp" -#include "Category_String.hpp" - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -namespace ZEOLITE_PUBLIC_NAMESPACE { -#endif // ZEOLITE_PUBLIC_NAMESPACE - -namespace { -extern const S& Var_stdout; -extern const S& Var_stderr; -extern const S& Var_error; -} // namespace - -struct ExtCategory_SimpleOutput : public Category_SimpleOutput { -}; - -struct ExtType_SimpleOutput : public Type_SimpleOutput { - inline ExtType_SimpleOutput(Category_SimpleOutput& p, Params<0>::Type params) : Type_SimpleOutput(p, params) {} - - ReturnTuple Call_error(const S& self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("SimpleOutput.error") - return ReturnTuple(Var_error); - } - - ReturnTuple Call_stderr(const S& self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("SimpleOutput.stderr") - return ReturnTuple(Var_stderr); - } - - ReturnTuple Call_stdout(const S& self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("SimpleOutput.stdout") - return ReturnTuple(Var_stdout); - } -}; - -namespace { -struct Writer { - virtual void Write(const PrimString& message) = 0; - virtual void Flush() = 0; - virtual ~Writer() {} -}; -} // namespace - -struct ExtValue_SimpleOutput : public Value_SimpleOutput { - inline ExtValue_SimpleOutput(S p, const ParamTuple& params, S w) - : Value_SimpleOutput(p, params), writer(w) {} - - ReturnTuple Call_flush(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("SimpleOutput.flush") - std::lock_guard lock(mutex); - writer->Flush(); - return ReturnTuple(); - } - - ReturnTuple Call_write(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { - TRACE_FUNCTION("SimpleOutput.write") - const S& Var_arg1 = (args.At(0)); - std::lock_guard lock(mutex); - writer->Write(TypeValue::Call(args.At(0), Function_Formatted_formatted, - ParamTuple(), ArgTuple()).Only()->AsString()); - return ReturnTuple(); - } - - std::mutex mutex; - const S writer; -}; - -namespace { - -class StreamWriter : public Writer { - public: - StreamWriter(std::ostream& o) : output(o) {} - - void Write(const PrimString& message) final { - output << message; - } - - void Flush() final {} - - private: - std::ostream& output; -}; - -class ErrorWriter : public Writer { - public: - void Write(const PrimString& message) final { - output << message; - } - - void Flush() final { - FAIL() << output.str(); - } - - std::ostringstream output; -}; - -const S& Var_stdout = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new StreamWriter(std::cout)))); -const S& Var_stderr = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new StreamWriter(std::cerr)))); -const S& Var_error = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new ErrorWriter()))); - -} // namespace - -Category_SimpleOutput& CreateCategory_SimpleOutput() { - static auto& category = *new ExtCategory_SimpleOutput(); - return category; -} -S CreateType_SimpleOutput(Params<0>::Type params) { - static const auto cached = S_get(new ExtType_SimpleOutput(CreateCategory_SimpleOutput(), Params<0>::Type())); - return cached; -} - -#ifdef ZEOLITE_PUBLIC_NAMESPACE -} // namespace ZEOLITE_PUBLIC_NAMESPACE -using namespace ZEOLITE_PUBLIC_NAMESPACE; -#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/README.md b/lib/util/README.md new file mode 100644 --- /dev/null +++ b/lib/util/README.md @@ -0,0 +1,12 @@ +# [Zeolite Utility Library](https://github.com/ta0kira/zeolite/tree/master/lib/util) + +## Library Usage + +- See filenames ending in `.0rp` for documentation. + +- Include `"lib/util"` in `public_deps` or `private_deps` in your + `.zeolite-module`. + +## Configuring and Building + +This library is automatically built by `zeolite-setup`. diff --git a/lib/util/extra.0rp b/lib/util/extra.0rp new file mode 100644 --- /dev/null +++ b/lib/util/extra.0rp @@ -0,0 +1,73 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// A type with only one value. +// +// Notes: +// - The built-in type with no values is the meta-type all. Void should be used +// when an actual value is required but no other type makes sense. +concrete Void { + refines Formatted + + defines Equals + defines LessThan + + // Return the only value of type Void. + @type void () -> (Void) +} + +// Contains either a value or an error message. +// +// Params: +// - #x: The value type to be contained. +concrete ErrorOr<|#x> { + // Create a new instance containing a value. + @category value<#x> (#x) -> (ErrorOr<#x>) + // Create a new instance containing an error message. + @category error (Formatted) -> (ErrorOr) + + // Return true iff there is an error message. + @value isError () -> (Bool) + + // Get the contained value. Crashes if there is no value. + @value getValue () -> (#x) + // Get the error message. Crashes if there is no error. + @value getError () -> (Formatted) + // Convert the error to any other ErrorOr type. Crashes if there is no error. + @value convertError () -> (ErrorOr) +} + +// Command-line program arguments. +concrete Argv { + refines ReadAt + refines SubSequence + + // Return the global set of arguments for the program. + // + // Notes: + // - This is empty outside of the main program thread. + // - When used in unit tests, arg 0 is "testcase" and the remaining args are + // set from args in the testcase. (See extra.0rt.) + @type global () -> ([ReadAt&SubSequence]) +} + +// A resource that requires explicit cleanup. +@value interface PersistentResource { + // Clean up the resource, subsequently making it unavailable. + freeResource () -> () +} diff --git a/lib/util/extra.0rt b/lib/util/extra.0rt new file mode 100644 --- /dev/null +++ b/lib/util/extra.0rt @@ -0,0 +1,126 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "Argv checks" { + success + args "arg1" "arg2" "arg3" "arg4" +} + +unittest global { + Int count <- Argv.global().size() + if (count != 5) { + fail(count) + } + \ Testing.checkEquals(Argv.global().readAt(0),"testcase") + \ Testing.checkEquals(Argv.global().readAt(1),"arg1") + \ Testing.checkEquals(Argv.global().readAt(2),"arg2") + \ Testing.checkEquals(Argv.global().readAt(3),"arg3") + \ Testing.checkEquals(Argv.global().readAt(4),"arg4") +} + +unittest subSequence { + ReadAt argv <- Argv.global().subSequence(2,2) + Int count <- argv.size() + if (count != 2) { + fail(count) + } + \ Testing.checkEquals(argv.readAt(0),"arg2") + \ Testing.checkEquals(argv.readAt(1),"arg3") +} + + +testcase "Argv readAt out of bounds" { + crash + require "index 5" +} + +unittest test { + \ Argv.global().readAt(5) +} + + +testcase "Argv subSequence out of bounds" { + crash + require "index 5" +} + +unittest test { + \ Argv.global().subSequence(5,1) +} + + +testcase "ErrorOr checks" { + success +} + +unittest withValue { + ErrorOr value <- ErrorOr:value(10) + if (value.isError()) { + fail("Failed") + } + \ Testing.checkEquals(value.getValue(),10) +} + +unittest withError { + ErrorOr value <- ErrorOr:error("error message") + if (!value.isError()) { + fail("Failed") + } + \ Testing.checkEquals(value.getError().formatted(),"error message") +} + +unittest convertError { + scoped { + ErrorOr error <- ErrorOr:error("error message") + } in ErrorOr value <- error.convertError() + \ Testing.checkEquals(value.getError().formatted(),"error message") +} + + +testcase "ErrorOr getError() crashes with value" { + crash + require "empty" +} + +unittest test { + ErrorOr value <- ErrorOr:value(10) + \ value.getError() +} + + +testcase "ErrorOr getValue() crashes with error" { + crash + require "error message" +} + +unittest test { + ErrorOr value <- ErrorOr:error("error message") + \ value.getValue() +} + + +testcase "ErrorOr convertError() crashes with no error" { + crash + require "no error" +} + +unittest test { + ErrorOr value <- ErrorOr:value(10) + \ value.convertError() +} + diff --git a/lib/util/extra.0rx b/lib/util/extra.0rx new file mode 100644 --- /dev/null +++ b/lib/util/extra.0rx @@ -0,0 +1,74 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +define Void { + @category Void singleton <- Void{ } + + formatted () { + return "void" + } + + equals (_,_) { + return true + } + + lessThan (_,_) { + return true + } + + void () { + return singleton + } +} + +define ErrorOr { + @value optional #x maybeValue + @value optional Formatted maybeError + + value (x) { + return ErrorOr<#x>{ x, empty } + } + + error (message) { + return ErrorOr{ empty, message } + } + + isError () { + return !present(maybeValue) && present(maybeError) + } + + getValue () { + if (present(maybeValue)) { + return require(maybeValue) + } else { + fail(require(maybeError)) + } + } + + getError () { + return require(maybeError) + } + + convertError () { + if (!present(maybeError)) { + fail("no error present to convert") + } else { + return ErrorOr{ empty, maybeError } + } + } +} diff --git a/lib/util/input.0rp b/lib/util/input.0rp new file mode 100644 --- /dev/null +++ b/lib/util/input.0rp @@ -0,0 +1,63 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// Reader of discrete blocks of data. +// +// Params: +// - #x: The value type to be read. +@value interface BlockReader<|#x> { + // Read a block of the given size. + // + // Notes: + // - Negative values can have any behavior. + // - This should gracefully handle block sizes that exceed available input. + readBlock (Int) -> (#x) + + // Returns true iff nothing further can be read. + pastEnd () -> (Bool) +} + +// Line-based text reader. +concrete TextReader { + // Create from a BlockReader. + @type fromBlockReader (BlockReader) -> (TextReader) + + // Create and read all data from a block reader. + // + // Notes: + // - If the BlockReader is also a PersistentResource, make sure to separately + // clean it up afterward. + @type readAll (BlockReader) -> (String) + + // Return the next line of data, up to '\n' or '\r'. + // + // Notes: + // - This does not automatically handle varying newline types. + @value readNextLine () -> (String) + + // Returns true iff nothing further can be read. + @value pastEnd () -> (Bool) +} + +// Simple input sources. +concrete SimpleInput { + refines BlockReader + + // Returns a BlockReader for standard input. + @type stdin () -> (BlockReader) +} diff --git a/lib/util/input.0rt b/lib/util/input.0rt new file mode 100644 --- /dev/null +++ b/lib/util/input.0rt @@ -0,0 +1,91 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "TextReader checks" { + success +} + +concrete Helper { + @type checkNext (TextReader,String) -> () +} + +define Helper { + checkNext (reader,line) { + if (reader.pastEnd()) { + fail("past end") + } + String value <- reader.readNextLine() + if (value != line) { + fail(value) + } + } +} + +concrete FakeFile { + refines BlockReader + + @type create () -> (FakeFile) +} + +define FakeFile { + @value Int counter + + create () { + return FakeFile{ 0 } + } + + readBlock (_) { + cleanup { + counter <- counter+1 + } in if (counter == 0) { + return "this is a " + } elif (counter == 1) { + return "partial line\nwith " + } elif (counter == 2) { + return "some more data\nand\nmore lines" + } elif (counter == 3) { + return "\nunfinished" + } else { + fail("too many reads") + } + } + + pastEnd () { + return counter > 3 + } +} + +unittest correctSplit { + TextReader reader <- TextReader.fromBlockReader(FakeFile.create()) + \ Helper.checkNext(reader,"this is a partial line") + \ Helper.checkNext(reader,"with some more data") + \ Helper.checkNext(reader,"and") + \ Helper.checkNext(reader,"more lines") + \ Helper.checkNext(reader,"unfinished") + if (!reader.pastEnd()) { + fail("not past end") + } + if (reader.readNextLine() != "") { + fail("reused data") + } +} + +unittest readAll { + String allContents <- TextReader.readAll(FakeFile.create()) + \ Testing.checkEquals(allContents,"this is a partial line\nwith some more data\nand\nmore lines\nunfinished") +} diff --git a/lib/util/input.0rx b/lib/util/input.0rx new file mode 100644 --- /dev/null +++ b/lib/util/input.0rx @@ -0,0 +1,79 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +define TextReader { + @value BlockReader reader + @value String buffer + + fromBlockReader (reader) { + return TextReader{ reader, "" } + } + + readAll (reader) { + [Append&Build] builder <- String.builder() + while (!reader.pastEnd()) { + \ builder.append(reader.readBlock($ExprLookup[BLOCK_READ_SIZE]$)) + } + return builder.build() + } + + readNextLine () { + while (true) { + Int newline <- findNewline() + if (newline < 0) { + if (reader.pastEnd()) { + cleanup { + buffer <- "" + } in return buffer + } else { + buffer <- buffer+reader.readBlock($ExprLookup[BLOCK_READ_SIZE]$) + } + } else { + return takeLine(newline) + } + } + return "" + } + + pastEnd () { + return buffer.size() == 0 && reader.pastEnd() + } + + @value findNewline () -> (Int) + findNewline () { + scoped { + Int position <- 0 + } in while (position < buffer.size()) { + Char c <- buffer.readAt(position) + // TODO: Maybe the line separator should be a factory argument. + if (c == '\n' || c == '\r') { + return position + } + } update { + position <- position+1 + } + return -1 + } + + @value takeLine (Int) -> (String) + takeLine (position) { + String data <- buffer.subSequence(0,position) + buffer <- buffer.subSequence(position+1,buffer.size()-position-1) + return data + } +} diff --git a/lib/util/iterator.0rp b/lib/util/iterator.0rp new file mode 100644 --- /dev/null +++ b/lib/util/iterator.0rp @@ -0,0 +1,127 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// Random-access writes. (Like the ReadAt built-in type.) +// +// Params: +// - #x: The value type to be written. +@value interface WriteAt<#x|> { + refines Container + + // Write the value at the given index and return self. + writeAt (Int,#x) -> (#self) +} + +// Read at the current position. +// +// Params: +// - #x: The value type to be read. +@value interface ReadCurrent<|#x> { + // Return the value at the current position. + readCurrent () -> (#x) +} + +// Write at the current position. +// +// Params: +// - #x: The value type to be written. +@value interface WriteCurrent<#x|> { + // Write the value at the current position and return self. + writeCurrent (#x) -> (#self) +} + +// Forward iteration. +@value interface IterateForward { + // Return a copy that has been moved forward once. (Do not mutate self.) + // + // Notes: + // - This should crash if pastForwardEnd() is true. + forward () -> (#self) + // Returns true iff no more forward movement is possible. + pastForwardEnd () -> (Bool) +} + +// Reverse iteration. +@value interface IterateReverse { + // Return a copy that has been moved in reverse once. (Do not mutate self.) + // + // Notes: + // - This should crash if pastReverseEnd() is true. + reverse () -> (#self) + // Returns true iff no more reverse movement is possible. + pastReverseEnd () -> (Bool) +} + +// Iterator for forward/reverse reading. +@value interface ReadIterator<|#x> { + refines ReadCurrent<#x> + refines IterateForward + refines IterateReverse +} + +// Iterator for forward/reverse writing. +@value interface WriteIterator<#x|> { + refines WriteCurrent<#x> + refines IterateForward + refines IterateReverse +} + +// Iterator for forward/reverse reading and writing. +@value interface Iterator<#x> { + refines ReadIterator<#x> + refines WriteIterator<#x> +} + +// Automatic read iteration from ReadAt. +// +// Params: +// - #x: The value type to be read. +concrete AutoReadIterator<#x> { + refines ReadIterator<#x> + + // Create an iterator from a ReadAt. + @category from<#y> (ReadAt<#y>) -> (AutoReadIterator<#y>) + // Create an iterator from a ReadAt starting at an offset. + @category fromOffset<#y> (ReadAt<#y>,Int) -> (AutoReadIterator<#y>) +} + +// Automatic write iteration from WriteAt. +// +// Params: +// - #x: The value type to be written. +concrete AutoWriteIterator<#x> { + refines WriteIterator<#x> + + // Create an iterator from a WriteAt. + @category from<#y> (WriteAt<#y>) -> (AutoWriteIterator<#y>) + // Create an iterator from a WriteAt starting at an offset. + @category fromOffset<#y> (WriteAt<#y>,Int) -> (AutoWriteIterator<#y>) +} + +// Automatic read/write iteration from ReadAt&WriteAt. +// +// Params: +// - #x: The value type to be read/written. +concrete AutoIterator<#x> { + refines Iterator<#x> + + // Create an iterator from a ReadAt&WriteAt. + @category from<#y> ([ReadAt<#y>&WriteAt<#y>]) -> (AutoIterator<#y>) + // Create an iterator from a ReadAt&WriteAt starting at an offset. + @category fromOffset<#y> ([ReadAt<#y>&WriteAt<#y>],Int) -> (AutoIterator<#y>) +} diff --git a/lib/util/iterator.0rt b/lib/util/iterator.0rt new file mode 100644 --- /dev/null +++ b/lib/util/iterator.0rt @@ -0,0 +1,192 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "iterate ReadIterator" { + success +} + +unittest forwardRead { + String s <- "abcde" + Int count <- 0 + scoped { + ReadIterator iter <- AutoReadIterator:from(s) + } in while (!iter.pastForwardEnd()) { + $ReadOnly[count,iter]$ + if (iter.readCurrent() != s.readAt(count)) { + fail(iter.readCurrent()) + } + } update { + count <- count+1 + iter <- iter.forward() + } + if (count != s.size()) { + fail(count) + } +} + +unittest reverseRead { + String s <- "abcde" + Int count <- s.size()-1 + scoped { + ReadIterator iter <- AutoReadIterator:fromOffset(s,count) + } in while (!iter.pastReverseEnd()) { + $ReadOnly[count,iter]$ + \ Testing.checkEquals(iter.readCurrent(),s.readAt(count)) + } update { + count <- count-1 + iter <- iter.reverse() + } + if (count != -1) { + fail(count) + } +} + + +testcase "iterate WriteIterator" { + success +} + +unittest forwardWrite { + String s <- "abcde" + Int count <- 0 + scoped { + WriteChecker checker <- WriteChecker.create(s) + WriteIterator iter <- AutoWriteIterator:from(checker) + } in while (!iter.pastForwardEnd()) { + $ReadOnly[count,iter]$ + \ iter.writeCurrent(s.readAt(count)) + } update { + count <- count+1 + iter <- iter.forward() + } + if (count != s.size()) { + fail(count) + } +} + +unittest reverseWrite { + String s <- "abcde" + Int count <- s.size()-1 + scoped { + WriteChecker checker <- WriteChecker.create(s) + WriteIterator iter <- AutoWriteIterator:fromOffset(checker,count) + } in while (!iter.pastReverseEnd()) { + $ReadOnly[count,iter]$ + \ iter.writeCurrent(s.readAt(count)) + } update { + count <- count-1 + iter <- iter.reverse() + } + if (count != -1) { + fail(count) + } +} + +concrete WriteChecker { + refines WriteAt + + @type create (String) -> (WriteChecker) +} + +define WriteChecker { + @value String content + + create (string) { + return WriteChecker{ string } + } + + writeAt (index,c) { + \ Testing.checkEquals(c,content.readAt(index)) + return self + } + + size () { + return content.size() + } +} + + +testcase "iterate Iterator" { + success +} + +unittest forwardReadWrite { + String s <- "abcde" + Int count <- 0 + scoped { + ReadWriteChecker checker <- ReadWriteChecker.create(s) + Iterator iter <- AutoIterator:from(checker) + } in while (!iter.pastForwardEnd()) { + $ReadOnly[count,iter]$ + \ Testing.checkEquals(iter.readCurrent(),s.readAt(count)) + \ iter.writeCurrent(iter.readCurrent()) + } update { + count <- count+1 + iter <- iter.forward() + } + if (count != s.size()) { + fail(count) + } +} + +unittest reverseReadWrite { + String s <- "abcde" + Int count <- s.size()-1 + scoped { + ReadWriteChecker checker <- ReadWriteChecker.create(s) + Iterator iter <- AutoIterator:fromOffset(checker,count) + } in while (!iter.pastReverseEnd()) { + $ReadOnly[count,iter]$ + \ Testing.checkEquals(iter.readCurrent(),s.readAt(count)) + \ iter.writeCurrent(iter.readCurrent()) + } update { + count <- count-1 + iter <- iter.reverse() + } + if (count != -1) { + fail(count) + } +} + +concrete ReadWriteChecker { + refines ReadAt + refines WriteAt + + @type create (String) -> (ReadWriteChecker) +} + +define ReadWriteChecker { + @value String content + + create (string) { + return ReadWriteChecker{ string } + } + + readAt (index) { + return content.readAt(index) + } + + writeAt (index,c) { + \ Testing.checkEquals(c,content.readAt(index)) + return self + } + + size () { + return content.size() + } +} diff --git a/lib/util/iterator.0rx b/lib/util/iterator.0rx new file mode 100644 --- /dev/null +++ b/lib/util/iterator.0rx @@ -0,0 +1,171 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +define AutoReadIterator { + @value ReadAt<#x> container + @value Int position + + from (container) { + return fromOffset<#y>(container,0) + } + + fromOffset (container,position) { + Int position2 <- position + if (position < 0) { + position2 <- -1 + } + if (position >= container.size() || container.size() == 0) { + position2 <- container.size() + } + return AutoReadIterator<#y>{ container, position } + } + + readCurrent () { + if (pastForwardEnd() || pastReverseEnd()) { + \ LazyStream.new() + .append("Position ") + .append(position) + .append(" is out of bounds") + .writeTo(SimpleOutput.error()) + } + return container.readAt(position) + } + + forward () { + return fromOffset<#x>(container,position+1) + } + + pastForwardEnd () { + return position >= container.size() + } + + reverse () { + return fromOffset<#x>(container,position-1) + } + + pastReverseEnd () { + return position < 0 || container.size() == 0 + } +} + +define AutoWriteIterator { + @value WriteAt<#x> container + @value Int position + + from (container) { + return fromOffset<#y>(container,0) + } + + fromOffset (container,position) { + Int position2 <- position + if (position < 0) { + position2 <- -1 + } + if (position >= container.size() || container.size() == 0) { + position2 <- container.size() + } + return AutoWriteIterator<#y>{ container, position } + } + + writeCurrent (x) { + if (pastForwardEnd() || pastReverseEnd()) { + \ LazyStream.new() + .append("Position ") + .append(position) + .append(" is out of bounds") + .writeTo(SimpleOutput.error()) + } + \ container.writeAt(position,x) + return self + } + + forward () { + return fromOffset<#x>(container,position+1) + } + + pastForwardEnd () { + return position >= container.size() + } + + reverse () { + return fromOffset<#x>(container,position-1) + } + + pastReverseEnd () { + return position < 0 || container.size() == 0 + } +} + +define AutoIterator { + @value [ReadAt<#x>&WriteAt<#x>] container + @value Int position + + from (container) { + return fromOffset<#y>(container,0) + } + + fromOffset (container,position) { + Int position2 <- position + if (position < 0) { + position2 <- -1 + } + if (position >= container.size() || container.size() == 0) { + position2 <- container.size() + } + return AutoIterator<#y>{ container, position } + } + + readCurrent () { + if (pastForwardEnd() || pastReverseEnd()) { + \ LazyStream.new() + .append("Position ") + .append(position) + .append(" is out of bounds") + .writeTo(SimpleOutput.error()) + } + return container.readAt(position) + } + + writeCurrent (x) { + if (pastForwardEnd() || pastReverseEnd()) { + \ LazyStream.new() + .append("Position ") + .append(position) + .append(" is out of bounds") + .writeTo(SimpleOutput.error()) + } + \ container.writeAt(position,x) + return self + } + + forward () { + return fromOffset<#x>(container,position+1) + } + + pastForwardEnd () { + return position >= container.size() + } + + reverse () { + return fromOffset<#x>(container,position-1) + } + + pastReverseEnd () { + return position < 0 || container.size() == 0 + } +} diff --git a/lib/util/output.0rp b/lib/util/output.0rp new file mode 100644 --- /dev/null +++ b/lib/util/output.0rp @@ -0,0 +1,69 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// A sink for writing data. +// +// Params: +// - #x: The value type to be written. +@value interface Writer<#x|> { + write (#x) -> () +} + +// A sink that can be flushed. +// +// Params: +// - #x: The value type to be written. +@value interface BufferedWriter<#x|> { + refines Writer<#x> + + flush () -> () +} + +// A sink that might perform a partial write. +// +// Params: +// - #x: The value type to be written. +@value interface BlockWriter<#x|> { + // Write the data and return the size of what was written. + writeBlock (#x) -> (Int) +} + +// A lazy output stream that delays writing. +// +// Params: +// - #x: The value type to be written. +concrete LazyStream<#x> { + refines Append<#x> + + // Create a new stream. + @type new () -> (LazyStream<#x>) + // Write the data to the BufferedWriter. (Do not mutate the stream.) + @value writeTo (BufferedWriter<#x>) -> () +} + +// Simple output destinations. +concrete SimpleOutput { + refines BufferedWriter + + // Returns a BufferedWriter for standard output. + @type stdout () -> (BufferedWriter) + // Returns a BufferedWriter for standard error. + @type stderr () -> (BufferedWriter) + // Returns a BufferedWriter that crashes with the output as the error message. + @type error () -> (BufferedWriter) +} diff --git a/lib/util/output.0rt b/lib/util/output.0rt new file mode 100644 --- /dev/null +++ b/lib/util/output.0rt @@ -0,0 +1,48 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +testcase "stdout writer" { + success + require stdout "message" + exclude stderr "message" +} + +unittest test { + \ LazyStream.new().append("message").writeTo(SimpleOutput.stdout()) +} + + +testcase "stderr writer" { + success + require stderr "message" + exclude stdout "message" +} + +unittest test { + \ LazyStream.new().append("message").writeTo(SimpleOutput.stderr()) +} + + +testcase "error writer" { + crash + require "message" +} + +unittest test { + \ LazyStream.new().append("message").writeTo(SimpleOutput.error()) +} diff --git a/lib/util/output.0rx b/lib/util/output.0rx new file mode 100644 --- /dev/null +++ b/lib/util/output.0rx @@ -0,0 +1,45 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +define LazyStream { + @value optional #x value + @value optional LazyStream<#x> next + + new () { + return LazyStream<#x>{ empty, empty } + } + + append (value2) { + return LazyStream<#x>{ value2, self } + } + + @value recursive (Writer<#x>) -> () + recursive (writer) { + if (present(next)) { + \ require(next).recursive(writer) + } + if (present(value)) { + \ writer.write(require(value)) + } + } + + writeTo (writer) { + \ recursive(writer) + \ writer.flush() + } +} diff --git a/lib/util/src/Extension_Argv.cpp b/lib/util/src/Extension_Argv.cpp new file mode 100644 --- /dev/null +++ b/lib/util/src/Extension_Argv.cpp @@ -0,0 +1,96 @@ +/* ----------------------------------------------------------------------------- +Copyright 2020-2021 Kevin P. Barry +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + http://www.apache.org/licenses/LICENSE-2.0 +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include "category-source.hpp" +#include "Streamlined_Argv.hpp" +#include "Category_Formatted.hpp" +#include "Category_String.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +S CreateValue_Argv(S parent, const ParamTuple& params, int st, int sz); + +namespace { +extern const S& Var_global; +} // namespace + +struct ExtCategory_Argv : public Category_Argv { +}; + +struct ExtType_Argv : public Type_Argv { + inline ExtType_Argv(Category_Argv& p, Params<0>::Type params) : Type_Argv(p, params) {} + + ReturnTuple Call_global(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Argv.global") + return ReturnTuple(Var_global); + } +}; + +struct ExtValue_Argv : public Value_Argv { + inline ExtValue_Argv(S p, const ParamTuple& params, int st, int sz) + : Value_Argv(p, params), start(st), size(sz) {} + + ReturnTuple Call_readAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Argv.readAt") + const PrimInt Var_arg1 = (args.At(0))->AsInt(); + return ReturnTuple(Box_String(Argv::GetArgAt(start + Var_arg1))); + } + + ReturnTuple Call_size(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Argv.size") + return ReturnTuple(Box_Int(GetSize())); + } + + ReturnTuple Call_subSequence(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Argv.subSequence") + const PrimInt Var_arg1 = (args.At(0))->AsInt(); + const PrimInt Var_arg2 = (args.At(1))->AsInt(); + if (Var_arg1 < 0 || (Var_arg1 > 0 && Var_arg1 >= GetSize())) { + FAIL() << "index " << Var_arg1 << " is out of bounds"; + } + if (Var_arg2 < 0 || Var_arg1 + Var_arg2 > GetSize()) { + FAIL() << "size " << Var_arg2 << " is invalid"; + } + return ReturnTuple(S(new ExtValue_Argv(parent, ParamTuple(), start + Var_arg1, Var_arg2))); + } + + inline int GetSize() const { return size < 0 ? Argv::ArgCount() : size; } + + const int start; + const int size; +}; + +namespace { +const S& Var_global = *new S(new ExtValue_Argv(CreateType_Argv(Params<0>::Type()), ParamTuple(), 0, -1)); +} // namespace + +Category_Argv& CreateCategory_Argv() { + static auto& category = *new ExtCategory_Argv(); + return category; +} +S CreateType_Argv(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_Argv(CreateCategory_Argv(), Params<0>::Type())); + return cached; +} +S CreateValue_Argv(S parent, const ParamTuple& params, int st, int sz) { + return S_get(new ExtValue_Argv(parent, params, st, sz)); +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/src/Extension_SimpleInput.cpp b/lib/util/src/Extension_SimpleInput.cpp new file mode 100644 --- /dev/null +++ b/lib/util/src/Extension_SimpleInput.cpp @@ -0,0 +1,90 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + http://www.apache.org/licenses/LICENSE-2.0 +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +// TODO: Maybe use C++ instead. +#include + +#include "category-source.hpp" +#include "Streamlined_SimpleInput.hpp" +#include "Category_Formatted.hpp" +#include "Category_String.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +namespace { +extern const S& Var_stdin; +} // namespace + +struct ExtCategory_SimpleInput : public Category_SimpleInput { +}; + +struct ExtType_SimpleInput : public Type_SimpleInput { + inline ExtType_SimpleInput(Category_SimpleInput& p, Params<0>::Type params) : Type_SimpleInput(p, params) {} + + ReturnTuple Call_stdin(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleInput.stdin") + return ReturnTuple(Var_stdin); + } +}; + +struct ExtValue_SimpleInput : public Value_SimpleInput { + inline ExtValue_SimpleInput(S p, const ParamTuple& params, const ValueTuple& args) : Value_SimpleInput(p, params) {} + + ReturnTuple Call_pastEnd(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleInput.pastEnd") + std::lock_guard lock(mutex); + return ReturnTuple(Box_Bool(zero_read)); + } + + ReturnTuple Call_readBlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleInput.readBlock") + std::lock_guard lock(mutex); + const int size = args.At(0)->AsInt(); + if (size < 0) { + FAIL() << "Read size " << size << " is invalid"; + } + std::string buffer(size, '\x00'); + const int read_size = read(STDIN_FILENO, &buffer[0], size); + if (read_size < 0) { + return ReturnTuple(Box_String("")); + } else { + zero_read = read_size == 0; + return ReturnTuple(Box_String(buffer.substr(0, read_size))); + } + } + + bool zero_read = false; + std::mutex mutex; +}; + +namespace { +const S& Var_stdin = *new S(new ExtValue_SimpleInput(CreateType_SimpleInput(Params<0>::Type()), ParamTuple(), ArgTuple())); +} // namespace + +Category_SimpleInput& CreateCategory_SimpleInput() { + static auto& category = *new ExtCategory_SimpleInput(); + return category; +} +S CreateType_SimpleInput(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_SimpleInput(CreateCategory_SimpleInput(), Params<0>::Type())); + return cached; +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/src/Extension_SimpleOutput.cpp b/lib/util/src/Extension_SimpleOutput.cpp new file mode 100644 --- /dev/null +++ b/lib/util/src/Extension_SimpleOutput.cpp @@ -0,0 +1,136 @@ +/* ----------------------------------------------------------------------------- +Copyright 2019-2021 Kevin P. Barry +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + http://www.apache.org/licenses/LICENSE-2.0 +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +----------------------------------------------------------------------------- */ + +// Author: Kevin P. Barry [ta0kira@gmail.com] + +#include +#include +#include + +#include "category-source.hpp" +#include "Streamlined_SimpleOutput.hpp" +#include "Category_Formatted.hpp" +#include "Category_String.hpp" + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +namespace { +extern const S& Var_stdout; +extern const S& Var_stderr; +extern const S& Var_error; +} // namespace + +struct ExtCategory_SimpleOutput : public Category_SimpleOutput { +}; + +struct ExtType_SimpleOutput : public Type_SimpleOutput { + inline ExtType_SimpleOutput(Category_SimpleOutput& p, Params<0>::Type params) : Type_SimpleOutput(p, params) {} + + ReturnTuple Call_error(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleOutput.error") + return ReturnTuple(Var_error); + } + + ReturnTuple Call_stderr(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleOutput.stderr") + return ReturnTuple(Var_stderr); + } + + ReturnTuple Call_stdout(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleOutput.stdout") + return ReturnTuple(Var_stdout); + } +}; + +namespace { +struct Writer { + virtual void Write(const PrimString& message) = 0; + virtual void Flush() = 0; + virtual ~Writer() {} +}; +} // namespace + +struct ExtValue_SimpleOutput : public Value_SimpleOutput { + inline ExtValue_SimpleOutput(S p, const ParamTuple& params, S w) + : Value_SimpleOutput(p, params), writer(w) {} + + ReturnTuple Call_flush(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleOutput.flush") + std::lock_guard lock(mutex); + writer->Flush(); + return ReturnTuple(); + } + + ReturnTuple Call_write(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("SimpleOutput.write") + const S& Var_arg1 = (args.At(0)); + std::lock_guard lock(mutex); + writer->Write(TypeValue::Call(args.At(0), Function_Formatted_formatted, + ParamTuple(), ArgTuple()).Only()->AsString()); + return ReturnTuple(); + } + + std::mutex mutex; + const S writer; +}; + +namespace { + +class StreamWriter : public Writer { + public: + StreamWriter(std::ostream& o) : output(o) {} + + void Write(const PrimString& message) final { + output << message; + } + + void Flush() final {} + + private: + std::ostream& output; +}; + +class ErrorWriter : public Writer { + public: + void Write(const PrimString& message) final { + output << message; + } + + void Flush() final { + FAIL() << output.str(); + } + + std::ostringstream output; +}; + +const S& Var_stdout = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new StreamWriter(std::cout)))); +const S& Var_stderr = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new StreamWriter(std::cerr)))); +const S& Var_error = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new ErrorWriter()))); + +} // namespace + +Category_SimpleOutput& CreateCategory_SimpleOutput() { + static auto& category = *new ExtCategory_SimpleOutput(); + return category; +} +S CreateType_SimpleOutput(Params<0>::Type params) { + static const auto cached = S_get(new ExtType_SimpleOutput(CreateCategory_SimpleOutput(), Params<0>::Type())); + return cached; +} + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/tests.0rt b/lib/util/tests.0rt deleted file mode 100644 --- a/lib/util/tests.0rt +++ /dev/null @@ -1,262 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2020 Kevin P. Barry - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -testcase "stdout writer" { - success - require stdout "message" - exclude stderr "message" -} - -unittest test { - \ LazyStream.new().append("message").writeTo(SimpleOutput.stdout()) -} - - -testcase "stderr writer" { - success - require stderr "message" - exclude stdout "message" -} - -unittest test { - \ LazyStream.new().append("message").writeTo(SimpleOutput.stderr()) -} - - -testcase "error writer" { - crash - require "message" -} - -unittest test { - \ LazyStream.new().append("message").writeTo(SimpleOutput.error()) -} - - -testcase "iterate ReadIterator" { - success -} - -unittest forward { - String s <- "abcde" - Int count <- 0 - scoped { - ReadIterator iter <- ReadIterator:fromReadPosition(s) - } in while (!iter.pastForwardEnd()) { - if (iter.readCurrent() != s.readPosition(count)) { - fail(iter.readCurrent()) - } - } update { - count <- count+1 - iter <- iter.forward() - } - if (count != s.readSize()) { - fail(count) - } -} - -unittest reverse { - String s <- "abcde" - Int count <- s.readSize()-1 - scoped { - ReadIterator iter <- ReadIterator:fromReadPositionAt(s,count) - } in while (!iter.pastReverseEnd()) { - if (iter.readCurrent() != s.readPosition(count)) { - fail(iter.readCurrent()) - } - } update { - count <- count-1 - iter <- iter.reverse() - } - if (count != -1) { - fail(count) - } -} - - -testcase "Argv checks" { - success - args "arg1" "arg2" "arg3" "arg4" -} - -unittest global { - Int count <- Argv.global().readSize() - if (count != 5) { - fail(count) - } - \ Testing.checkEquals(Argv.global().readPosition(0),"testcase") - \ Testing.checkEquals(Argv.global().readPosition(1),"arg1") - \ Testing.checkEquals(Argv.global().readPosition(2),"arg2") - \ Testing.checkEquals(Argv.global().readPosition(3),"arg3") - \ Testing.checkEquals(Argv.global().readPosition(4),"arg4") -} - -unittest subSequence { - ReadPosition argv <- Argv.global().subSequence(2,2) - Int count <- argv.readSize() - if (count != 2) { - fail(count) - } - \ Testing.checkEquals(argv.readPosition(0),"arg2") - \ Testing.checkEquals(argv.readPosition(1),"arg3") -} - - -testcase "Argv readPosition out of bounds" { - crash - require "index 5" -} - -unittest test { - \ Argv.global().readPosition(5) -} - - -testcase "Argv subSequence out of bounds" { - crash - require "index 5" -} - -unittest test { - \ Argv.global().subSequence(5,1) -} - - -testcase "TextReader checks" { - success -} - -concrete Helper { - @type checkNext (TextReader,String) -> () -} - -define Helper { - checkNext (reader,line) { - if (reader.pastEnd()) { - fail("past end") - } - String value <- reader.readNextLine() - if (value != line) { - fail(value) - } - } -} - -concrete FakeFile { - refines BlockReader - - @type create () -> (FakeFile) -} - -define FakeFile { - @value Int counter - - create () { - return FakeFile{ 0 } - } - - readBlock (_) { - cleanup { - counter <- counter+1 - } in if (counter == 0) { - return "this is a " - } elif (counter == 1) { - return "partial line\nwith " - } elif (counter == 2) { - return "some more data\nand\nmore lines" - } elif (counter == 3) { - return "\nunfinished" - } else { - fail("too many reads") - } - } - - pastEnd () { - return counter > 3 - } -} - -unittest correctSplit { - TextReader reader <- TextReader.fromBlockReader(FakeFile.create()) - \ Helper.checkNext(reader,"this is a partial line") - \ Helper.checkNext(reader,"with some more data") - \ Helper.checkNext(reader,"and") - \ Helper.checkNext(reader,"more lines") - \ Helper.checkNext(reader,"unfinished") - if (!reader.pastEnd()) { - fail("not past end") - } - if (reader.readNextLine() != "") { - fail("reused data") - } -} - -unittest readAll { - String allContents <- TextReader.readAll(FakeFile.create()) - \ Testing.checkEquals(allContents,"this is a partial line\nwith some more data\nand\nmore lines\nunfinished") -} - - -testcase "ErrorOr checks" { - success -} - -unittest withValue { - ErrorOr value <- ErrorOr:value(10) - if (value.isError()) { - fail("Failed") - } - \ Testing.checkEquals(value.getValue(),10) -} - -unittest withError { - ErrorOr value <- ErrorOr:error("error message") - if (!value.isError()) { - fail("Failed") - } - \ Testing.checkEquals(value.getError().formatted(),"error message") -} - -unittest convertError { - scoped { - ErrorOr error <- ErrorOr:error("error message") - } in ErrorOr value <- error.convertError() - \ Testing.checkEquals(value.getError().formatted(),"error message") -} - - -testcase "ErrorOr getError() crashes with value" { - crash - require "empty" -} - -unittest test { - ErrorOr value <- ErrorOr:value(10) - \ value.getError() -} - - -testcase "ErrorOr getValue() crashes with error" { - crash - require "error message" -} - -unittest test { - ErrorOr value <- ErrorOr:error("error message") - \ value.getValue() -} diff --git a/lib/util/util.0rp b/lib/util/util.0rp deleted file mode 100644 --- a/lib/util/util.0rp +++ /dev/null @@ -1,118 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2019-2020 Kevin P. Barry - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -// TODO: Split this up, or otherwise organize it better. - -concrete Void { - refines Formatted - - defines Equals - defines LessThan - - @type void () -> (Void) -} - -@value interface ReadCurrent<|#x> { - readCurrent () -> (#x) -} - -@value interface IterateForward { - forward () -> (#self) - pastForwardEnd () -> (Bool) -} - -@value interface IterateReverse { - reverse () -> (#self) - pastReverseEnd () -> (Bool) -} - -concrete ReadIterator<|#x> { - refines ReadCurrent<#x> - refines IterateForward - refines IterateReverse - - @category fromReadPosition<#y> (ReadPosition<#y>) -> (ReadIterator<#y>) - @category fromReadPositionAt<#y> (ReadPosition<#y>,Int) -> (ReadIterator<#y>) -} - -@value interface Writer<#x|> { - write (#x) -> () -} - -@value interface BufferedWriter<#x|> { - refines Writer<#x> - - flush () -> () -} - -concrete LazyStream<#x> { - @type new () -> (LazyStream<#x>) - @value append (#x) -> (LazyStream<#x>) - @value writeTo (BufferedWriter<#x>) -> () -} - -concrete SimpleOutput { - refines BufferedWriter - - @type stdout () -> (BufferedWriter) - @type stderr () -> (BufferedWriter) - @type error () -> (BufferedWriter) -} - -concrete SimpleInput { - refines BlockReader - - @type stdin () -> (BlockReader) -} - -concrete Argv { - refines ReadPosition - - @type global () -> (ReadPosition) -} - -@value interface PersistentResource { - freeResource () -> () -} - -@value interface BlockReader<|#x> { - readBlock (Int) -> (#x) - pastEnd () -> (Bool) -} - -@value interface BlockWriter<#x|> { - writeBlock (#x) -> (Int) -} - -concrete TextReader { - @type fromBlockReader (BlockReader) -> (TextReader) - @type readAll (BlockReader) -> (String) - @value readNextLine () -> (String) - @value pastEnd () -> (Bool) -} - -concrete ErrorOr<|#x> { - @category value<#x> (#x) -> (ErrorOr<#x>) - @category error (Formatted) -> (ErrorOr) - - @value isError () -> (Bool) - - @value getValue () -> (#x) - @value getError () -> (Formatted) - @value convertError () -> (ErrorOr) -} diff --git a/lib/util/util.0rx b/lib/util/util.0rx deleted file mode 100644 --- a/lib/util/util.0rx +++ /dev/null @@ -1,207 +0,0 @@ -/* ----------------------------------------------------------------------------- -Copyright 2019-2020 Kevin P. Barry - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. ------------------------------------------------------------------------------ */ - -// Author: Kevin P. Barry [ta0kira@gmail.com] - -define Void { - @category Void singleton <- Void{ } - - formatted () { - return "void" - } - - equals (_,_) { - return true - } - - lessThan (_,_) { - return true - } - - void () { - return singleton - } -} - -define ReadIterator { - @value ReadPosition<#x> reader - @value Int position - - fromReadPosition (reader) { - return fromReadPositionAt<#y>(reader,0) - } - - fromReadPositionAt (reader,position) { - Int position2 <- position - if (position < 0) { - position2 <- -1 - } - if (position >= reader.readSize() || reader.readSize() == 0) { - position2 <- reader.readSize() - } - return ReadIterator<#y>{ reader, position } - } - - readCurrent () { - if (pastForwardEnd() || pastReverseEnd()) { - \ LazyStream.new() - .append("Position ") - .append(position) - .append(" is out of bounds") - .writeTo(SimpleOutput.error()) - } - return reader.readPosition(position) - } - - forward () { - return fromReadPositionAt<#x>(reader,position+1) - } - - pastForwardEnd () { - return position >= reader.readSize() - } - - reverse () { - return fromReadPositionAt<#x>(reader,position-1) - } - - pastReverseEnd () { - return position < 0 || reader.readSize() == 0 - } -} - -define LazyStream { - @value optional #x value - @value optional LazyStream<#x> next - - new () { - return LazyStream<#x>{ empty, empty } - } - - append (value2) { - return LazyStream<#x>{ value2, self } - } - - @value recursive (Writer<#x>) -> () - recursive (writer) { - if (present(next)) { - \ require(next).recursive(writer) - } - if (present(value)) { - \ writer.write(require(value)) - } - } - - writeTo (writer) { - \ recursive(writer) - \ writer.flush() - } -} - -define TextReader { - @value BlockReader reader - @value String buffer - - fromBlockReader (reader) { - return TextReader{ reader, "" } - } - - readAll (reader) { - Builder builder <- String.builder() - while (!reader.pastEnd()) { - \ builder.append(reader.readBlock($ExprLookup[BLOCK_READ_SIZE]$)) - } - return builder.build() - } - - readNextLine () { - while (true) { - Int newline <- findNewline() - if (newline < 0) { - if (reader.pastEnd()) { - cleanup { - buffer <- "" - } in return buffer - } else { - buffer <- buffer+reader.readBlock($ExprLookup[BLOCK_READ_SIZE]$) - } - } else { - return takeLine(newline) - } - } - return "" - } - - pastEnd () { - return buffer.readSize() == 0 && reader.pastEnd() - } - - @value findNewline () -> (Int) - findNewline () { - scoped { - Int position <- 0 - } in while (position < buffer.readSize()) { - Char c <- buffer.readPosition(position) - // TODO: Maybe the line separator should be a factory argument. - if (c == '\n' || c == '\r') { - return position - } - } update { - position <- position+1 - } - return -1 - } - - @value takeLine (Int) -> (String) - takeLine (position) { - String data <- buffer.subSequence(0,position) - buffer <- buffer.subSequence(position+1,buffer.readSize()-position-1) - return data - } -} - -define ErrorOr { - @value optional #x maybeValue - @value optional Formatted maybeError - - value (x) { - return ErrorOr<#x>{ x, empty } - } - - error (message) { - return ErrorOr{ empty, message } - } - - isError () { - return !present(maybeValue) && present(maybeError) - } - - getValue () { - if (present(maybeValue)) { - return require(maybeValue) - } else { - fail(require(maybeError)) - } - } - - getError () { - return require(maybeError) - } - - convertError () { - return ErrorOr{ empty, maybeError } - } -} diff --git a/src/Base/CompilerError.hs b/src/Base/CompilerError.hs --- a/src/Base/CompilerError.hs +++ b/src/Base/CompilerError.hs @@ -1,5 +1,5 @@ {- ----------------------------------------------------------------------------- -Copyright 2019-2020 Kevin P. Barry +Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -30,13 +30,15 @@ (!!>), collectAllM_, collectFirstM_, + emptyErrorM, errorFromIO, isCompilerError, isCompilerErrorM, isCompilerSuccess, isCompilerSuccessM, + mapCompilerM, + mapCompilerM_, mapErrorsM, - mapErrorsM_, ) where import Control.Monad.IO.Class @@ -102,11 +104,11 @@ collectFirstM_ :: (Foldable f, CollectErrorsM m) => f (m a) -> m () collectFirstM_ = fmap (const ()) . collectFirstM -mapErrorsM :: CollectErrorsM m => (a -> m b) -> [a] -> m [b] -mapErrorsM f = collectAllM . map f +mapCompilerM :: CollectErrorsM m => (a -> m b) -> [a] -> m [b] +mapCompilerM f = collectAllM . map f -mapErrorsM_ :: CollectErrorsM m => (a -> m b) -> [a] -> m () -mapErrorsM_ f = collectAllM_ . map f +mapCompilerM_ :: CollectErrorsM m => (a -> m b) -> [a] -> m () +mapCompilerM_ f = collectAllM_ . map f isCompilerError :: (ErrorContextT t, ErrorContextM (t Identity)) => t Identity a -> Bool isCompilerError = runIdentity . isCompilerErrorT @@ -119,6 +121,12 @@ isCompilerSuccessM :: CollectErrorsM m => m a -> m Bool isCompilerSuccessM x = collectFirstM [x >> return True,return False] + +mapErrorsM :: CollectErrorsM m => [String] -> m a +mapErrorsM es = mapCompilerM_ compilerErrorM es >> emptyErrorM + +emptyErrorM :: CollectErrorsM m => m a +emptyErrorM = compilerErrorM "" errorFromIO :: (MonadIO m, ErrorContextM m) => IO a -> m a errorFromIO x = do diff --git a/src/Base/MergeTree.hs b/src/Base/MergeTree.hs --- a/src/Base/MergeTree.hs +++ b/src/Base/MergeTree.hs @@ -1,5 +1,5 @@ {- ----------------------------------------------------------------------------- -Copyright 2020 Kevin P. Barry +Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -138,4 +138,4 @@ mergeAllM = fmap mergeAll . collectAllM matchOnlyLeaf :: (PreserveMerge a, CollectErrorsM m) => a -> m (T a) -matchOnlyLeaf = reduceMergeTree (const $ compilerErrorM "") (const $ compilerErrorM "") return +matchOnlyLeaf = reduceMergeTree (const emptyErrorM) (const emptyErrorM) return diff --git a/src/Base/Positional.hs b/src/Base/Positional.hs --- a/src/Base/Positional.hs +++ b/src/Base/Positional.hs @@ -49,7 +49,7 @@ (a -> b -> m c) -> Positional a -> Positional b -> m [c] processPairs f (Positional ps1) (Positional ps2) | length ps1 == length ps2 = - mapErrorsM (uncurry f) (zip ps1 ps2) + mapCompilerM (uncurry f) (zip ps1 ps2) | otherwise = mismatchError ps1 ps2 processPairsM :: (Show a, Show b, Mergeable c, CollectErrorsM m) => diff --git a/src/Cli/Compiler.hs b/src/Cli/Compiler.hs --- a/src/Cli/Compiler.hs +++ b/src/Cli/Compiler.hs @@ -86,8 +86,8 @@ compileModule :: (PathIOHandler r, CompilerBackend b) => r -> b -> ModuleSpec -> TrackedErrorsIO () compileModule resolver backend (ModuleSpec p d em is is2 ps xs ts es ep m f) = do - as <- fmap fixPaths $ mapErrorsM (resolveModule resolver (p d)) is - as2 <- fmap fixPaths $ mapErrorsM (resolveModule resolver (p d)) is2 + as <- fmap fixPaths $ mapCompilerM (resolveModule resolver (p d)) is + as2 <- fmap fixPaths $ mapCompilerM (resolveModule resolver (p d)) is2 let ca0 = Map.empty deps1 <- loadPublicDeps compilerHash f ca0 as let ca1 = ca0 `Map.union` mapMetadata deps1 @@ -117,7 +117,7 @@ let pc = map (getCategoryName . wvData) $ filter (not . hasCodeVisibility ModuleOnly) cs2 let tc = map (getCategoryName . wvData) $ filter (hasCodeVisibility ModuleOnly) cs2 let dc = map (getCategoryName . wvData) $ filter (hasCodeVisibility FromDependency) $ filter (not . hasCodeVisibility ModuleOnly) cs - xa <- mapErrorsM (loadPrivateSource resolver compilerHash p) xs + xa <- mapCompilerM (loadPrivateSource resolver compilerHash p) xs fs <- compileLanguageModule cm xa mf <- maybeCreateMain cm xa m eraseCachedData (p d) @@ -131,12 +131,12 @@ let paths2 = base:s0:s1:(getIncludePathsForDeps (deps1' ++ deps2)) ++ ep' ++ paths' let hxx = filter (isSuffixOf ".hpp" . coFilename) fs let other = filter (not . isSuffixOf ".hpp" . coFilename) fs - os1 <- mapErrorsM (writeOutputFile paths2) $ hxx ++ other + os1 <- mapCompilerM (writeOutputFile paths2) $ hxx ++ other let files = map (\f2 -> getCachedPath (p d) (show $ coNamespace f2) (coFilename f2)) fs ++ map (\f2 -> p getSourceFile f2) es - files' <- mapErrorsM checkOwnedFile files + files' <- mapCompilerM checkOwnedFile files let ca = Map.fromList $ map (\c -> (getCategoryName c,getCategoryNamespace c)) $ map wvData cs2 - os2 <- fmap concat $ mapErrorsM (compileExtraSource (ns0,ns1) ca paths2) es + os2 <- fmap concat $ mapCompilerM (compileExtraSource (ns0,ns1) ca paths2) es let (hxx',cxx,os') = sortCompiledFiles files' let (osCat,osOther) = partitionEithers os2 let os1' = resolveObjectDeps (deps1' ++ deps2) path path (os1 ++ osCat) @@ -270,15 +270,15 @@ (LanguageModule _ _ _ cs0 ps0 ts0 cs1 ps1 ts1 _ _ _) <- fmap (createLanguageModule [] [] Map.empty) $ loadModuleGlobals resolver p (PublicNamespace,PrivateNamespace) ps Nothing deps1 deps2 xs' <- zipWithContents resolver p xs - ds <- mapErrorsM parseInternalSource xs' + ds <- mapCompilerM parseInternalSource xs' let ds2 = concat $ map (\(_,_,d2) -> d2) ds tm <- foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1,ts0,ts1] let cs = filter isValueConcrete $ cs1++ps1++ts1 let ca = Set.fromList $ map getCategoryName $ filter isValueConcrete cs let ca' = foldr Set.delete ca $ map dcName ds2 let testingCats = Set.fromList $ map getCategoryName ts1 - ts <- fmap concat $ mapErrorsM (\n -> generate (n `Set.member` testingCats) tm n) $ Set.toList ca' - mapErrorsM_ writeTemplate ts where + ts <- fmap concat $ mapCompilerM (\n -> generate (n `Set.member` testingCats) tm n) $ Set.toList ca' + mapCompilerM_ writeTemplate ts where generate testing tm n = do (_,t) <- getConcreteCategory tm ([],n) let ctx = FileContext testing tm Set.empty Map.empty @@ -296,11 +296,11 @@ [FilePath] -> LoadedTests -> TrackedErrorsIO [((Int,Int),TrackedErrors ())] runModuleTests resolver backend base tp (LoadedTests p d m em deps1 deps2) = do let paths = base:(cmPublicSubdirs m ++ cmPrivateSubdirs m ++ getIncludePathsForDeps deps1) - mapErrorsM_ showSkipped $ filter (not . isTestAllowed) $ cmTestFiles m + mapCompilerM_ showSkipped $ filter (not . isTestAllowed) $ cmTestFiles m ts' <- zipWithContents resolver p $ map (d ) $ filter isTestAllowed $ cmTestFiles m path <- errorFromIO $ canonicalizePath (p d) cm <- fmap (createLanguageModule [] [] em) $ loadModuleGlobals resolver path (NoNamespace,NoNamespace) [] (Just m) deps1 [] - mapErrorsM (runSingleTest backend cm path paths (m:deps2)) ts' where + mapCompilerM (runSingleTest backend cm path paths (m:deps2)) ts' where allowTests = Set.fromList tp isTestAllowed t = if null allowTests then True else t `Set.member` allowTests showSkipped f = compilerWarningM $ "Skipping tests in " ++ f ++ " due to explicit test filter." @@ -340,7 +340,7 @@ warnPublic :: PathIOHandler r => r -> FilePath -> [CategoryName] -> [CategoryName] -> [ObjectFile] -> [FilePath] -> TrackedErrorsIO () -warnPublic resolver p pc dc os = mapErrorsM_ checkPublic where +warnPublic resolver p pc dc os = mapCompilerM_ checkPublic where checkPublic d = do d2 <- resolveModule resolver p d when (not $ d2 `Set.member` neededPublic) $ compilerWarningM $ "Dependency \"" ++ d ++ "\" does not need to be public" diff --git a/src/Cli/RunCompiler.hs b/src/Cli/RunCompiler.hs --- a/src/Cli/RunCompiler.hs +++ b/src/Cli/RunCompiler.hs @@ -44,10 +44,10 @@ base <- resolveBaseModule resolver ts <- fmap snd $ foldM (preloadTests base) (Map.empty,[]) ds checkTestFilters ts - allResults <- fmap concat $ mapErrorsM (runModuleTests resolver backend base tp) ts + allResults <- fmap concat $ mapCompilerM (runModuleTests resolver backend base tp) ts let passed = sum $ map (fst . fst) allResults let failed = sum $ map (snd . fst) allResults - processResults passed failed (mapErrorsM_ snd allResults) where + processResults passed failed (mapCompilerM_ snd allResults) where compilerHash = getCompilerHash backend preloadTests base (ca,ms) d = do m <- loadModuleMetadata compilerHash f ca (p d) @@ -111,9 +111,7 @@ recursive r da (p2,d0) = do isSystem <- isSystemModule r p2 d0 if isSystem - then do - compilerWarningM $ "Skipping system dependency " ++ d0 ++ " for " ++ p2 ++ "." - return da + then return da else do d <- errorFromIO $ canonicalizePath (p2 d0) rm <- loadRecompile d @@ -126,7 +124,7 @@ return da' runCompiler resolver backend (CompileOptions _ _ _ ds _ _ p CompileRecompile f) = do - mapErrorsM_ recompileSingle ds where + mapCompilerM_ recompileSingle ds where compilerHash = getCompilerHash backend recompileSingle d0 = do d <- errorFromIO $ canonicalizePath (p d0) @@ -163,8 +161,8 @@ d' <- errorFromIO $ canonicalizePath (p d) (is',is2') <- maybeUseConfig d' base <- resolveBaseModule resolver - as <- fmap fixPaths $ mapErrorsM (resolveModule resolver d') is' - as2 <- fmap fixPaths $ mapErrorsM (resolveModule resolver d') is2' + as <- fmap fixPaths $ mapCompilerM (resolveModule resolver d') is' + as2 <- fmap fixPaths $ mapCompilerM (resolveModule resolver d') is2' deps1 <- loadPublicDeps compilerHash f Map.empty (base:as) deps2 <- loadPublicDeps compilerHash f (mapMetadata deps1) as2 path <- errorFromIO $ canonicalizePath p @@ -180,12 +178,12 @@ runCompiler resolver backend (CompileOptions h is is2 ds es ep p m f) = mapM_ compileSingle ds where compileSingle d = do - as <- fmap fixPaths $ mapErrorsM (resolveModule resolver (p d)) is - as2 <- fmap fixPaths $ mapErrorsM (resolveModule resolver (p d)) is2 + as <- fmap fixPaths $ mapCompilerM (resolveModule resolver (p d)) is + as2 <- fmap fixPaths $ mapCompilerM (resolveModule resolver (p d)) is2 isConfigured <- isPathConfigured p d when (isConfigured && f == DoNotForce) $ do compilerErrorM $ "Module " ++ d ++ " has an existing configuration. " ++ - "Recompile with -r or use -f to overwrite the config." + "Recompile with -r or use -f to overwrite the config." absolute <- errorFromIO $ canonicalizePath p let rm = ModuleConfig { mcRoot = absolute, diff --git a/src/Cli/TestRunner.hs b/src/Cli/TestRunner.hs --- a/src/Cli/TestRunner.hs +++ b/src/Cli/TestRunner.hs @@ -60,7 +60,7 @@ return ((0,1),ts >> return ()) | otherwise = do let (_,ts') = getCompilerSuccess ts - allResults <- mapErrorsM runSingle ts' + allResults <- mapCompilerM runSingle ts' let passed = sum $ map (fst . fst) allResults let failed = sum $ map (snd . fst) allResults let result = collectAllM_ $ map snd allResults @@ -116,23 +116,23 @@ let ce = checkExcluded es comp err out let compError = if null comp then return () - else (mapErrorsM_ compilerErrorM comp) (tpName t,[t])) ts - mapErrorsM_ testClash $ Map.toList ts' + mapCompilerM_ testClash $ Map.toList ts' testClash (_,[_]) = return () testClash (n,ts) = "unittest " ++ show n ++ " is defined multiple times" !!> - (mapErrorsM_ (compilerErrorM . ("Defined at " ++) . formatFullContext) $ sort $ map tpContext ts) + (mapCompilerM_ (compilerErrorM . ("Defined at " ++) . formatFullContext) $ sort $ map tpContext ts) execute s2 rs es args cs ds ts = do let result = compileAll args cs ds ts @@ -166,8 +166,8 @@ let cs' = map (setCategoryNamespace ns1) cs compileTestsModule cm ns1 args cs' ds ts - checkRequired rs comp err out = mapErrorsM_ (checkSubsetForRegex True comp err out) rs - checkExcluded es comp err out = mapErrorsM_ (checkSubsetForRegex False comp err out) es + checkRequired rs comp err out = mapCompilerM_ (checkSubsetForRegex True comp err out) rs + checkExcluded es comp err out = mapCompilerM_ (checkSubsetForRegex False comp err out) es checkSubsetForRegex expected comp err out (OutputPattern OutputAny r) = checkForRegex expected (comp ++ err ++ out) r "compiler output or test output" checkSubsetForRegex expected comp _ _ (OutputPattern OutputCompiler r) = @@ -184,7 +184,7 @@ createBinary (CxxOutput _ f2 _ ns req content) xx = do dir <- errorFromIO $ mkdtemp "/tmp/ztest_" errorFromIO $ hPutStrLn stderr $ "Writing temporary files to " ++ dir - sources <- mapErrorsM (writeSingleFile dir) xx + sources <- mapCompilerM (writeSingleFile dir) xx -- TODO: Cache CompileMetadata here for debugging failures. let sources' = resolveObjectDeps deps p dir sources let main = dir f2 diff --git a/src/Compilation/ProcedureContext.hs b/src/Compilation/ProcedureContext.hs --- a/src/Compilation/ProcedureContext.hs +++ b/src/Compilation/ProcedureContext.hs @@ -206,10 +206,10 @@ let mapped = Map.fromListWith (++) $ map (\f -> (pfParam f,[pfFilter f])) (ctx ^. pcIntFilters) let positional = map (getFilters mapped) (map vpParam $ pValues $ ctx ^. pcIntParams) assigned <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ ctx ^. pcIntParams) ps - subbed <- fmap Positional $ mapErrorsM (assignFilters assigned) positional + subbed <- fmap Positional $ mapCompilerM (assignFilters assigned) positional processPairs_ (validateAssignment r allFilters) ps subbed -- Check initializer types. - ms <- fmap Positional $ mapErrorsM (subSingle pa') (ctx ^. pcMembers) + ms <- fmap Positional $ mapCompilerM (subSingle pa') (ctx ^. pcMembers) processPairs_ (checkInit r allFilters) ms (Positional $ zip ([1..] :: [Int]) $ pValues ts) return () where @@ -218,7 +218,7 @@ (Just fs) -> fs _ -> [] assignFilters fm fs = do - mapErrorsM (uncheckedSubFilter $ getValueForParam fm) fs + mapCompilerM (uncheckedSubFilter $ getValueForParam fm) fs checkInit r fa (MemberValue c2 n t0) (i,t1) = do checkValueAssignment r fa t1 t0 mapErrorsM_ (checkSingle na) vs + ValidateNames _ _ na -> mapCompilerM_ (checkSingle na) vs _ -> return () where checkSingle na (UsedVariable c n) = @@ -303,7 +303,7 @@ check (ValidateNames ns ts ra) = do case vs of Just _ -> check (ValidatePositions ts) >> return () - Nothing -> mapErrorsM_ alwaysError $ Map.toList ra + Nothing -> mapCompilerM_ alwaysError $ Map.toList ra return (ValidateNames ns ts Map.empty) alwaysError (n,_) = compilerErrorM $ "Named return " ++ show n ++ " might not be initialized" ++ @@ -357,7 +357,7 @@ checkReserved [] _ = return () checkReserved (m@(n2,_):ms) rs | n2 /= n = checkReserved ms (m:rs) - | otherwise = (mapErrorsM_ singleError (m:rs)) (vpParam p,vpContext p)) pi2 - mapErrorsM_ (checkFunction pm) fs2 - mapErrorsM_ (checkParam pm) pe + mapCompilerM_ (checkFunction pm) fs2 + mapCompilerM_ (checkParam pm) pe fa' <- fmap (Map.union fa) $ getFilterMap pi2 fi2 - mapErrorsM_ (checkFilter r fa') fi2 + mapCompilerM_ (checkFilter r fa') fi2 checkFilter r fa (ParamFilter c2 n2 f) = validateTypeFilter r fa f return () diff --git a/src/CompilerCxx/Code.hs b/src/CompilerCxx/Code.hs --- a/src/CompilerCxx/Code.hs +++ b/src/CompilerCxx/Code.hs @@ -42,6 +42,7 @@ startCleanupTracing, startFunctionTracing, startInitTracing, + startMainTracing, startTestTracing, testsOnlyCategoryGuard, testsOnlySourceGuard, @@ -87,9 +88,11 @@ clearCompiled :: CompiledData [String] -> CompiledData [String] clearCompiled (CompiledData r _) = CompiledData r [] -startFunctionTracing :: CategoryName -> FunctionName -> String -startFunctionTracing CategoryNone f = "TRACE_FUNCTION(" ++ show (show f) ++ ")" -startFunctionTracing t f = "TRACE_FUNCTION(" ++ show (show t ++ "." ++ show f) ++ ")" +startFunctionTracing :: ScopedFunction c -> String +startFunctionTracing f = "TRACE_FUNCTION(" ++ show (functionDebugName f) ++ ")" + +startMainTracing :: String -> String +startMainTracing n = "TRACE_FUNCTION(" ++ show n ++ ")" startInitTracing :: CategoryName -> SymbolScope -> String startInitTracing t s = "TRACE_FUNCTION(" ++ show (show t ++ " " ++ show s ++ " init") ++ ")" diff --git a/src/CompilerCxx/CxxFiles.hs b/src/CompilerCxx/CxxFiles.hs --- a/src/CompilerCxx/CxxFiles.hs +++ b/src/CompilerCxx/CxxFiles.hs @@ -237,7 +237,6 @@ (addSourceIncludes $ addStreamlinedHeader t $ addIncludes req' out) common (StreamlinedTemplate t tm) = fmap (:[]) streamlinedTemplate where streamlinedTemplate = do - let filename = templateStreamlined (getCategoryName t) [cp,tp,vp] <- getProcedureScopes tm Map.empty defined (CompiledData req out) <- fmap (addNamespace t) $ concatM [ declareCustomValueGetter t, @@ -247,12 +246,14 @@ defineCustomGetters t, defineCustomValueGetter t ] + let req' = Set.unions [req,getCategoryMentions t] return $ CxxOutput (Just $ getCategoryName t) filename (getCategoryNamespace t) (Set.fromList [getCategoryNamespace t]) - req - (addSourceIncludes $ addStreamlinedHeader t $ addIncludes req out) + req' + (addSourceIncludes $ addStreamlinedHeader t $ addIncludes req' out) + filename = templateStreamlined (getCategoryName t) defined = DefinedCategory { dcContext = [], dcName = getCategoryName t, @@ -274,11 +275,12 @@ epProcedure = failProcedure f } createArg = InputValue [] . VariableName . ("arg" ++) . show - failProcedure f = Procedure [] [ - NoValueExpression [] $ LineComment $ "TODO: Implement " ++ funcName f ++ ".", - FailCall [] (Literal (StringLiteral [] $ funcName f ++ " is not implemented")) + failProcedure f = Procedure [] $ [ + asLineComment $ "TODO: Implement " ++ functionDebugName f ++ "." + ] ++ map asLineComment (formatFunctionTypes f) ++ [ + RawFailCall (functionDebugName f ++ " is not implemented (see " ++ filename ++ ")") ] - funcName f = show (sfType f) ++ "." ++ show (sfName f) + asLineComment = NoValueExpression [] . LineComment common (NativeConcrete t d@(DefinedCategory _ _ pi _ _ fi ms _ _) ta ns em) = fmap (:[]) singleSource where singleSource = do let filename = sourceFilename (getCategoryName t) @@ -453,30 +455,30 @@ defineCustomCategory :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String]) defineCustomCategory t ps = concatM [ return $ onlyCode $ "struct " ++ categoryCustom (getCategoryName t) ++ " : public " ++ categoryName (getCategoryName t) ++ " {", - fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure Nothing) ps, + fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure FinalInlineFunction) ps, return $ onlyCode "};" ] defineCustomType :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String]) defineCustomType t ps = concatM [ return $ onlyCode $ "struct " ++ typeCustom (getCategoryName t) ++ " : public " ++ typeName (getCategoryName t) ++ " {", fmap indentCompiled $ customTypeConstructor t, - fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure Nothing) ps, + fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure FinalInlineFunction) ps, return $ onlyCode "};" ] defineCustomValue :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String]) defineCustomValue t ps = concatM [ return $ onlyCode $ "struct " ++ valueCustom (getCategoryName t) ++ " : public " ++ valueName (getCategoryName t) ++ " {", fmap indentCompiled $ customValueConstructor t, - fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure Nothing) ps, + fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure FinalInlineFunction) ps, return $ onlyCode "};" ] defineCategoryFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String]) - defineCategoryFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ Just $ categoryName $ getCategoryName t) + defineCategoryFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ OutOfLineFunction $ categoryName $ getCategoryName t) defineTypeFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String]) - defineTypeFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ Just $ typeName $ getCategoryName t) + defineTypeFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ OutOfLineFunction $ typeName $ getCategoryName t) defineValueFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String]) - defineValueFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ Just $ valueName $ getCategoryName t) + defineValueFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ OutOfLineFunction $ valueName $ getCategoryName t) declareCategoryOverrides = onlyCodes [ " std::string CategoryName() const final;", @@ -625,12 +627,21 @@ "CycleCheck<" ++ n2 ++ "> marker(*this);" ] +formatFunctionTypes :: Show c => ScopedFunction c -> [String] +formatFunctionTypes (ScopedFunction c _ _ s as rs ps fa _) = [location,args,returns,params] ++ filters where + location = show s ++ " function declared at " ++ formatFullContext c + args = "Arg Types: (" ++ intercalate ", " (map (show . pvType) $ pValues as) ++ ")" + returns = "Return Types: (" ++ intercalate ", " (map (show . pvType) $ pValues rs) ++ ")" + params = "Type Params: <" ++ intercalate ", " (map (show . vpParam) $ pValues ps) ++ ">" + filters = map singleFilter fa + singleFilter (ParamFilter _ n2 f) = " " ++ show n2 ++ " " ++ show f + createMainCommon :: String -> CompiledData [String] -> CompiledData [String] -> [String] createMainCommon n (CompiledData req0 out0) (CompiledData req1 out1) = baseSourceIncludes ++ mainSourceIncludes ++ depIncludes (req0 `Set.union` req1) ++ out0 ++ [ "int main(int argc, const char** argv) {", " SetSignalHandler();", - " " ++ startFunctionTracing CategoryNone (FunctionName n) + " " ++ startMainTracing n ] ++ map (" " ++) out1 ++ ["}"] where depIncludes req2 = map (\i -> "#include \"" ++ headerFilename i ++ "\"") $ Set.toList req2 @@ -650,7 +661,7 @@ generateTestFile :: (Ord c, Show c, CollectErrorsM m) => CategoryMap c -> ExprMap c -> [String] -> [TestProcedure c] -> m (CompiledData [String]) generateTestFile tm em args ts = "In the creation of the test binary procedure" ??> do - ts' <- fmap mconcat $ mapErrorsM (compileTestProcedure tm em) ts + ts' <- fmap mconcat $ mapCompilerM (compileTestProcedure tm em) ts (include,sel) <- selectTestFromArgv1 $ map tpName ts let (CompiledData req _) = ts' <> sel let file = testsOnlySourceGuard ++ createMainCommon "testcase" (onlyCodes include <> ts') (argv <> sel) @@ -858,13 +869,10 @@ | otherwise = onlyCodes [ "S<" ++ typeName (getCategoryName t) ++ "> " ++ typeCreator (getCategoryName t) ++ "(Params<" ++ show n ++ ">::Type params) {", - " static auto& cache = *new WeakInstanceMap<" ++ show n ++ ", " ++ typeName (getCategoryName t) ++ ">();", - " static auto& cache_mutex = *new std::mutex;", - " std::lock_guard lock(cache_mutex);", - " auto& cached = cache[GetKeyFromParams<" ++ show n ++ ">(params)];", - " S<" ++ typeName (getCategoryName t) ++ "> type = cached;", - " if (!type) { cached = type = S_get(new " ++ className ++ "(" ++ categoryCreator (getCategoryName t) ++ "(), params)); }", - " return type;", + " static auto& cache = *new InstanceCache<" ++ show n ++ ", " ++ typeName (getCategoryName t) ++ ">([](Params<" ++ show n ++ ">::Type params) {", + " return S_get(new " ++ className ++ "(" ++ categoryCreator (getCategoryName t) ++ "(), params));", + " });", + " return cache.GetOrCreate(params);", "}" ] diff --git a/src/CompilerCxx/LanguageModule.hs b/src/CompilerCxx/LanguageModule.hs --- a/src/CompilerCxx/LanguageModule.hs +++ b/src/CompilerCxx/LanguageModule.hs @@ -83,9 +83,9 @@ map (generateNativeInterface False) (onlyNativeInterfaces cs1) ++ map (generateNativeInterface False) (onlyNativeInterfaces ps1) ++ map (generateNativeInterface True) (onlyNativeInterfaces ts1) - xxPrivate <- fmap concat $ mapErrorsM (compilePrivate (tmPrivate,nsPrivate) (tmTesting,nsTesting)) xa - xxStreamlined <- fmap concat $ mapErrorsM (streamlined tmTesting) $ nub ss - xxVerbose <- fmap concat $ mapErrorsM (verbose tmTesting) $ nub ex + xxPrivate <- fmap concat $ mapCompilerM (compilePrivate (tmPrivate,nsPrivate) (tmTesting,nsTesting)) xa + xxStreamlined <- fmap concat $ mapCompilerM (streamlined tmTesting) $ nub ss + xxVerbose <- fmap concat $ mapCompilerM (verbose tmTesting) $ nub ex let allFiles = xxInterfaces ++ xxPrivate ++ xxStreamlined ++ xxVerbose noDuplicateFiles $ map (\f -> (coFilename f,coNamespace f)) allFiles return allFiles where @@ -114,8 +114,8 @@ when testing $ checkTests ds (cs1 ++ ps1) let dm = mapDefByName ds checkDefined dm Set.empty $ filter isValueConcrete cs2 - xxInterfaces <- fmap concat $ mapErrorsM (generateNativeInterface testing) (filter (not . isValueConcrete) cs2) - xxConcrete <- fmap concat $ mapErrorsM (generateConcrete cs ctx) ds + xxInterfaces <- fmap concat $ mapCompilerM (generateNativeInterface testing) (filter (not . isValueConcrete) cs2) + xxConcrete <- fmap concat $ mapCompilerM (generateConcrete cs ctx) ds return $ xxInterfaces ++ xxConcrete generateConcrete cs (FileContext testing tm ns em2) d = do tm' <- mergeInternalInheritance tm d @@ -127,7 +127,7 @@ fmap snd $ getConcreteCategory tm (dcContext d,dcName d) mapDefByName = Map.fromListWith (++) . map (\d -> (dcName d,[d])) ca = Set.fromList $ map getCategoryName $ filter isValueConcrete (cs1 ++ ps1 ++ ts1) - checkLocals ds tm = mapErrorsM_ (\d -> checkLocal tm (dcContext d) (dcName d)) ds + checkLocals ds tm = mapCompilerM_ (\d -> checkLocal tm (dcContext d) (dcName d)) ds checkLocal cs2 c n = when (not $ n `Set.member` cs2) $ compilerErrorM ("Category " ++ show n ++ @@ -135,7 +135,7 @@ " does not correspond to a visible category in this module") checkTests ds ps = do let pa = Map.fromList $ map (\c -> (getCategoryName c,getCategoryContext c)) $ filter isValueConcrete ps - mapErrorsM_ (checkTest pa) ds + mapCompilerM_ (checkTest pa) ds checkTest pa d = case dcName d `Map.lookup` pa of Nothing -> return () @@ -143,7 +143,7 @@ compilerErrorM ("Category " ++ show (dcName d) ++ formatFullContextBrace (dcContext d) ++ " was not declared as $TestsOnly$" ++ formatFullContextBrace c) - checkDefined dm ext = mapErrorsM_ (checkSingle dm ext) + checkDefined dm ext = mapCompilerM_ (checkSingle dm ext) checkSingle dm ext t = case (getCategoryName t `Set.member` ext,getCategoryName t `Map.lookup` dm) of (False,Just [_]) -> return () @@ -160,7 +160,7 @@ ("Category " ++ show (getCategoryName t) ++ formatFullContextBrace (getCategoryContext t) ++ " is defined " ++ show (length ds) ++ " times") !!> - mapErrorsM_ (\d -> compilerErrorM $ "Defined at " ++ formatFullContext (dcContext d)) ds + mapCompilerM_ (\d -> compilerErrorM $ "Defined at " ++ formatFullContext (dcContext d)) ds checkSupefluous es2 | null es2 = return () | otherwise = compilerErrorM $ "External categories either not concrete or not present: " ++ @@ -212,4 +212,4 @@ reconcile [] = compilerErrorM $ "No matches for main category " ++ show n ++ " ($TestsOnly$ sources excluded)" reconcile ds = "Multiple matches for main category " ++ show n !!> - mapErrorsM_ (\d -> compilerErrorM $ "Defined at " ++ formatFullContext (dcContext d)) ds + mapCompilerM_ (\d -> compilerErrorM $ "Defined at " ++ formatFullContext (dcContext d)) ds diff --git a/src/CompilerCxx/Naming.hs b/src/CompilerCxx/Naming.hs --- a/src/CompilerCxx/Naming.hs +++ b/src/CompilerCxx/Naming.hs @@ -29,6 +29,7 @@ categoryGetter, categoryName, collectionName, + functionDebugName, functionName, headerFilename, headerStreamlined, @@ -144,6 +145,11 @@ callName :: FunctionName -> String callName f = "Call_" ++ show f + +functionDebugName :: ScopedFunction c -> String +functionDebugName f + | sfScope f == CategoryScope = show (sfType f) ++ ":" ++ show (sfName f) + | otherwise = show (sfType f) ++ "." ++ show (sfName f) functionName :: ScopedFunction c -> String functionName f = "Function_" ++ show (sfType f) ++ "_" ++ show (sfName f) diff --git a/src/CompilerCxx/Procedure.hs b/src/CompilerCxx/Procedure.hs --- a/src/CompilerCxx/Procedure.hs +++ b/src/CompilerCxx/Procedure.hs @@ -22,6 +22,7 @@ {-# LANGUAGE Safe #-} module CompilerCxx.Procedure ( + CxxFunctionType(..), categoriesFromTypes, categoriesFromDefine, categoriesFromRefine, @@ -72,17 +73,22 @@ "ReturnTuple " ++ name ++ "(const ParamTuple& params, const ValueTuple& args)" | sfScope f == TypeScope = "ReturnTuple " ++ name ++ - -- NOTE: Don't use Var_self, since self isn't accessible to @type functions. - "(const S& self, const ParamTuple& params, const ValueTuple& args)" + "(const S& Param_self, const ParamTuple& params, const ValueTuple& args)" | sfScope f == ValueScope = "ReturnTuple " ++ name ++ "(const S& Var_self, const ParamTuple& params, const ValueTuple& args)" | otherwise = undefined +data CxxFunctionType = + InlineFunction | + OutOfLineFunction String | + FinalInlineFunction + deriving Show + compileExecutableProcedure :: (Ord c, Show c, CollectErrorsM m) => - Maybe String -> ScopeContext c -> ScopedFunction c -> + CxxFunctionType -> ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> m (CompiledData [String]) -compileExecutableProcedure className ctx +compileExecutableProcedure cxxType ctx ff@(ScopedFunction _ _ _ s as1 rs1 ps1 _ _) pp@(ExecutableProcedure c pragmas c2 n as2 rs2 p) = do ctx' <- getProcedureContext ctx ff pp @@ -91,7 +97,6 @@ creationTrace <- setCreationTrace return $ wrapProcedure output procedureTrace creationTrace where - t = scName ctx compileWithReturn = do ctx0 <- getCleanContext >>= lift . flip ccSetNoTrace (any isNoTrace pragmas) compileProcedure ctx0 p >>= put @@ -115,24 +120,26 @@ ] close = "}" name = callName n - prefix = case className of - Nothing -> "" - Just cn -> cn ++ "::" + prefix = case cxxType of + OutOfLineFunction cn -> cn ++ "::" + _ -> "" + final = case cxxType of + FinalInlineFunction -> " final" + _ -> "" proto | s == CategoryScope = - returnType ++ " " ++ prefix ++ name ++ "(const ParamTuple& params, const ValueTuple& args) {" + returnType ++ " " ++ prefix ++ name ++ "(const ParamTuple& params, const ValueTuple& args)" ++ final ++ " {" | s == TypeScope = returnType ++ " " ++ prefix ++ name ++ - -- NOTE: Don't use Var_self, since self isn't accessible to @type functions. - "(const S& self, const ParamTuple& params, const ValueTuple& args) {" + "(const S& Param_self, const ParamTuple& params, const ValueTuple& args)" ++ final ++ " {" | s == ValueScope = returnType ++ " " ++ prefix ++ name ++ - "(const S& Var_self, const ParamTuple& params, const ValueTuple& args) {" + "(const S& Var_self, const ParamTuple& params, const ValueTuple& args)" ++ final ++ " {" | otherwise = undefined returnType = "ReturnTuple" setProcedureTrace | any isNoTrace pragmas = return [] - | otherwise = return [startFunctionTracing t n] + | otherwise = return [startFunctionTracing ff] setCreationTrace | not $ any isTraceCreation pragmas = return [] | s /= ValueScope = @@ -217,7 +224,7 @@ autoPositionalCleanup c e -- Multi-expression => must all be singles. getReturn rs = do - lift (mapErrorsM_ checkArity $ zip ([0..] :: [Int]) $ map (fst . snd) rs) must all be singles. getValues rs = do - (mapErrorsM_ checkArity $ zip ([0..] :: [Int]) $ map fst rs) Positional (InstanceOrInferred c) -> m [GeneralInstance] -disallowInferred = mapErrorsM disallow . pValues where +disallowInferred = mapCompilerM disallow . pValues where disallow (AssignedInstance _ t) = return t disallow (InferredInstance c) = compilerErrorM $ "Type inference is not allowed in reduce calls" ++ formatFullContextBrace c @@ -868,9 +880,9 @@ es' <- sequence $ map compileExpression $ pValues es (ts,es'') <- lift $ getValues es' self <- autoSelfType - ps' <- lift $ fmap Positional $ mapErrorsM (replaceSelfParam self) $ pValues ps + ps' <- lift $ fmap Positional $ mapCompilerM (replaceSelfParam self) $ pValues ps ps2 <- lift $ guessParamsFromArgs r fa f ps' (Positional ts) - lift $ mapErrorsM_ backgroundMessage $ zip3 (map vpParam $ pValues $ sfParams f) (pValues ps') (pValues ps2) + lift $ mapCompilerM_ backgroundMessage $ zip3 (map vpParam $ pValues $ sfParams f) (pValues ps') (pValues ps2) f' <- lift $ parsedToFunctionType f f'' <- lift $ assignFunctionParams r fa Map.empty ps2 f' -- Called an extra time so arg count mismatches have reasonable errors. @@ -896,7 +908,7 @@ assemble Nothing _ ValueScope ValueScope ps2 es2 = return $ callName (sfName f) ++ "(Var_self, " ++ ps2 ++ ", " ++ es2 ++ ")" assemble Nothing _ TypeScope TypeScope ps2 es2 = - return $ callName (sfName f) ++ "(self, " ++ ps2 ++ ", " ++ es2 ++ ")" + return $ callName (sfName f) ++ "(Param_self, " ++ ps2 ++ ", " ++ es2 ++ ")" assemble Nothing _ ValueScope TypeScope ps2 es2 = return $ typeBase ++ "::Call(parent, " ++ functionName f ++ ", " ++ ps2 ++ ", " ++ es2 ++ ")" assemble Nothing scoped _ _ ps2 es2 = @@ -912,7 +924,7 @@ getValues [(Positional ts,e2)] = return (ts,useAsArgs e2) -- Multi-expression => must all be singles. getValues rs = do - (mapErrorsM_ checkArity $ zip ([0..] :: [Int]) $ map fst rs) return t diff --git a/src/Config/LocalConfig.hs b/src/Config/LocalConfig.hs --- a/src/Config/LocalConfig.hs +++ b/src/Config/LocalConfig.hs @@ -29,7 +29,7 @@ import Control.Monad (when) import Control.Monad.IO.Class import Data.Hashable (hash) -import Data.List (intercalate,isPrefixOf,isSuffixOf) +import Data.List (intercalate,isPrefixOf,isSuffixOf,nub) import Data.Maybe (isJust) import Data.Version (showVersion,versionBranch) import GHC.IO.Handle @@ -92,11 +92,13 @@ macro (n,Just v) = "-D" ++ n ++ "=" ++ v macro (n,Nothing) = "-D" ++ n runCxxCommand (UnixBackend cb co _) (CompileToBinary m ss o ps lf) = do - let arFiles = filter (isSuffixOf ".a") ss - let otherFiles = filter (not . isSuffixOf ".a") ss - executeProcess cb (co ++ otherOptions ++ m:otherFiles ++ arFiles ++ ["-o", o]) parseOptional "include_paths:" [] (parseList parseQuoted) <*> parseRequired "mode:" readConfig writeConfig (ModuleConfig p d em is is2 es ep m) = do - es' <- fmap concat $ mapErrorsM writeConfig es + es' <- fmap concat $ mapCompilerM writeConfig es m' <- writeConfig m when (not $ null em) $ compilerErrorM "Only empty expression maps are allowed when writing" return $ [ @@ -317,8 +317,8 @@ f <- parseQuoted return (OtherSource f) writeConfig (CategorySource f cs ds) = do - mapErrorsM_ validateCategoryName cs - mapErrorsM_ validateCategoryName ds + mapCompilerM_ validateCategoryName cs + mapCompilerM_ validateCategoryName ds return $ [ "category_source {", indent ("source: " ++ show f), diff --git a/src/Module/ProcessMetadata.hs b/src/Module/ProcessMetadata.hs --- a/src/Module/ProcessMetadata.hs +++ b/src/Module/ProcessMetadata.hs @@ -222,7 +222,7 @@ loadDepsCommon f h ca pa0 getDeps ps = do (_,processed) <- fixedPaths >>= collect (pa0,[]) let cached = Map.union ca (Map.fromList processed) - mapErrorsM (check cached) processed where + mapCompilerM (check cached) processed where enforce = f /= ForceAll fixedPaths = mapM (errorFromIO . canonicalizePath) ps collect xa@(pa,xs) (p:ps2) @@ -313,8 +313,8 @@ when (not exists) $ compilerErrorM $ "Output file \"" ++ f ++ "\" is missing" checkDep time dep = do cm <- loadMetadata ca dep - mapErrorsM_ (checkInput time . (cmPath cm )) $ cmPublicFiles cm - checkObject (CategoryObjectFile _ _ fs) = mapErrorsM_ checkOutput fs + mapCompilerM_ (checkInput time . (cmPath cm )) $ cmPublicFiles cm + checkObject (CategoryObjectFile _ _ fs) = mapCompilerM_ checkOutput fs checkObject (OtherObjectFile f) = checkOutput f getRequires (CategoryObjectFile _ rs _) = rs getRequires _ = [] @@ -326,7 +326,7 @@ compilerErrorM $ "Required category " ++ show c ++ " is unresolved" checkMissing s0 s1 = do let missing = Set.toList $ Set.fromList s1 `Set.difference` Set.fromList s0 - mapErrorsM_ (\f -> compilerErrorM $ "Required path \"" ++ f ++ "\" has not been compiled") missing + mapCompilerM_ (\f -> compilerErrorM $ "Required path \"" ++ f ++ "\" has not been compiled") missing doesFileOrDirExist f2 = do existF <- errorFromIO $ doesFileExist f2 if existF @@ -403,8 +403,8 @@ loadModuleGlobals r p (ns0,ns1) fs m deps1 deps2 = do let public = Set.fromList $ map cmPath deps1 let deps2' = filter (\cm -> not $ cmPath cm `Set.member` public) deps2 - cs0 <- fmap concat $ mapErrorsM (processDeps False [FromDependency]) deps1 - cs1 <- fmap concat $ mapErrorsM (processDeps False [FromDependency,ModuleOnly]) deps2' + cs0 <- fmap concat $ mapCompilerM (processDeps False [FromDependency]) deps1 + cs1 <- fmap concat $ mapCompilerM (processDeps False [FromDependency,ModuleOnly]) deps2' cs2 <- loadAllPublic (ns0,ns1) fs cs3 <- case m of Just m2 -> processDeps True [FromDependency] m2 @@ -421,7 +421,7 @@ return $ map (updateCodeVisibility (Set.union (Set.fromList ss))) cs' loadAllPublic (ns2,ns3) fs2 = do fs2' <- zipWithContents r p fs2 - fmap concat $ mapErrorsM loadPublic fs2' + fmap concat $ mapCompilerM loadPublic fs2' where loadPublic p3 = do (pragmas,cs) <- parsePublicSource p3 diff --git a/src/Parser/Common.hs b/src/Parser/Common.hs --- a/src/Parser/Common.hs +++ b/src/Parser/Common.hs @@ -295,8 +295,12 @@ noParamSelf :: TextParser () noParamSelf = (<|> return ()) $ do - try paramSelf - compilerErrorM "#self is not allowed here" + -- NOTE: This preserves the trailing whitespace so that the error context + -- doesn't skip over whitespace or comments. + try $ do + string_ (show ParamSelf) + notFollowedBy (alphaNumChar <|> char '_') + compilerErrorM "#self is not allowed here" operatorSymbol :: TextParser Char operatorSymbol = labeled "operator symbol" $ satisfy (`Set.member` Set.fromList "+-*/%=!<>&|?") diff --git a/src/Parser/TypeCategory.hs b/src/Parser/TypeCategory.hs --- a/src/Parser/TypeCategory.hs +++ b/src/Parser/TypeCategory.hs @@ -127,7 +127,7 @@ return $ ValueDefine [c] t singleFilter :: TextParser (ParamFilter SourceContext) -singleFilter = try $ do +singleFilter = do c <- getSourceContext noParamSelf n <- sourceParser diff --git a/src/Test/Common.hs b/src/Test/Common.hs --- a/src/Test/Common.hs +++ b/src/Test/Common.hs @@ -86,16 +86,16 @@ parseFilterMap :: [(String,[String])] -> TrackedErrors ParamFilters parseFilterMap pa = do - pa2 <- mapErrorsM parseFilters pa + pa2 <- mapCompilerM parseFilters pa return $ Map.fromList pa2 where parseFilters (n,fs) = do - fs2 <- mapErrorsM (readSingle "(string)") fs + fs2 <- mapCompilerM (readSingle "(string)") fs return (ParamName n,fs2) parseTheTest :: ParseFromSource a => [(String,[String])] -> [String] -> TrackedErrors ([a],ParamFilters) parseTheTest pa xs = do - ts <- mapErrorsM (readSingle "(string)") xs + ts <- mapCompilerM (readSingle "(string)") xs pa2 <- parseFilterMap pa return (ts,pa2) @@ -149,7 +149,7 @@ containsNoDuplicates :: (Ord a, Show a) => [a] -> TrackedErrors () containsNoDuplicates expected = - (mapErrorsM_ checkSingle $ group $ sort expected) [a] -> [a] -> TrackedErrors () containsAtLeast actual expected = - (mapErrorsM_ (checkInActual $ Set.fromList actual) expected) [a] -> [a] -> TrackedErrors () containsAtMost actual expected = - (mapErrorsM_ (checkInExpected $ Set.fromList expected) actual) > compilerErrorM "error") `withContextM` "message" :: TrackedErrorsIO ()), checkSuccessAndWarnings "" () (return () `withContextM` "message"), - checkErrorAndWarnings "" "message\n" (compilerErrorM "" `withContextM` "message" :: TrackedErrorsIO ()), + checkErrorAndWarnings "" "message\n" (emptyErrorM `withContextM` "message" :: TrackedErrorsIO ()), checkSuccess 'a' (return 'a' `summarizeErrorsM` "message"), checkError "message\n error\n" (compilerErrorM "error" `summarizeErrorsM` "message" :: TrackedErrorsIO ()), @@ -67,7 +67,7 @@ checkErrorAndWarnings "warning\n" "message\n error\n" ((compilerWarningM "warning" >> compilerErrorM "error") `summarizeErrorsM` "message" :: TrackedErrorsIO ()), checkSuccessAndWarnings "" () (return () `summarizeErrorsM` "message"), - checkErrorAndWarnings "" "message\n" (compilerErrorM "" `summarizeErrorsM` "message" :: TrackedErrorsIO ()), + checkErrorAndWarnings "" "message\n" (emptyErrorM `summarizeErrorsM` "message" :: TrackedErrorsIO ()), checkSuccessAndWarnings "error\n" () (asCompilerWarnings $ compilerErrorM "error" :: TrackedErrorsIO ()), diff --git a/src/Test/TypeCategory.hs b/src/Test/TypeCategory.hs --- a/src/Test/TypeCategory.hs +++ b/src/Test/TypeCategory.hs @@ -75,7 +75,13 @@ checkShortParseSuccess "@value interface Type { call () -> (#self) }", checkShortParseFail "@value interface Type<#self> {}", - checkShortParseFail "@value interface Type { #self refines Foo }", + checkShortParseFail "@value interface Type { refines #self }", + checkShortParseFail "@value interface Type { #self allows Foo }", + checkShortParseFail "@value interface Type { #self requires Foo }", + checkShortParseFail "@value interface Type { #self defines Foo }", + checkShortParseSuccess "concrete Type<#x> { #x allows #self }", + checkShortParseSuccess "concrete Type<#x> { #x requires #self }", + checkShortParseFail "concrete Type<#x> { #x defines #self }", checkShortParseFail "@value interface Type { call<#self> () -> () }", checkOperationSuccess ("testfiles" "value_refines_value.0rx") (checkConnectedTypes defaultCategories), @@ -1214,7 +1220,7 @@ | length actual /= length expected = compilerErrorM $ "Different item counts: " ++ show actual ++ " (actual) vs. " ++ show expected ++ " (expected)" - | otherwise = mapErrorsM_ check (zip3 actual expected ([1..] :: [Int])) where + | otherwise = mapCompilerM_ check (zip3 actual expected ([1..] :: [Int])) where check (a,e,n) = f a e [a] -> [a] -> TrackedErrors () @@ -1306,10 +1312,10 @@ checked = do let r = CategoryResolver tm pa2 <- parseFilterMap pa - ia2 <- fmap Map.fromList $ mapErrorsM readInferred is - ts2 <- mapErrorsM (parsePair ia2 Covariant) ts + ia2 <- fmap Map.fromList $ mapCompilerM readInferred is + ts2 <- mapCompilerM (parsePair ia2 Covariant) ts let ka = Map.keysSet ia2 - gs' <- mapErrorsM parseGuess gs + gs' <- mapCompilerM parseGuess gs let f = Map.filterWithKey (\k _ -> not $ k `Set.member` ka) pa2 let ff = Map.filterWithKey (\k _ -> k `Set.member` ka) pa2 gs2 <- inferParamTypes r f ia2 ts2 diff --git a/src/Test/TypeInstance.hs b/src/Test/TypeInstance.hs --- a/src/Test/TypeInstance.hs +++ b/src/Test/TypeInstance.hs @@ -915,11 +915,11 @@ context = "With params = " ++ show pa ++ ", pair = (" ++ show x ++ "," ++ show y ++ ")" checked = do ([t1,t2],pa2) <- parseTheTest pa [x,y] - ia2 <- mapErrorsM readInferred is + ia2 <- mapCompilerM readInferred is gs' <- sequence $ fmap parseGuess gs let iaMap = Map.fromList ia2 -- TODO: Merge duplication with Test.TypeCategory. - pa3 <- fmap Map.fromList $ mapErrorsM (filterSub iaMap) $ Map.toList pa2 + pa3 <- fmap Map.fromList $ mapCompilerM (filterSub iaMap) $ Map.toList pa2 t2' <- uncheckedSubInstance (weakLookup iaMap) t2 check gs' $ checkGeneralMatch Resolver pa3 Covariant t1 t2' readInferred p = do @@ -934,7 +934,7 @@ Just t -> return t Nothing -> return $ singleType $ JustParamName True n filterSub im (k,fs) = do - fs' <- mapErrorsM (uncheckedSubFilter (weakLookup im)) fs + fs' <- mapCompilerM (uncheckedSubFilter (weakLookup im)) fs return (k,fs') checkConvertFail :: [(String, [String])] -> String -> String -> IO (TrackedErrors ()) diff --git a/src/Types/Builtin.hs b/src/Types/Builtin.hs --- a/src/Types/Builtin.hs +++ b/src/Types/Builtin.hs @@ -41,7 +41,7 @@ defaultCategories = Map.empty defaultCategoryDeps :: Set.Set CategoryName -defaultCategoryDeps = Set.fromList [BuiltinBool,BuiltinString,BuiltinChar,BuiltinInt,BuiltinFloat,BuiltinFormatted] +defaultCategoryDeps = Set.fromList [] boolRequiredValue :: ValueType boolRequiredValue = requiredSingleton BuiltinBool diff --git a/src/Types/Function.hs b/src/Types/Function.hs --- a/src/Types/Function.hs +++ b/src/Types/Function.hs @@ -57,15 +57,15 @@ validatateFunctionType :: (CollectErrorsM m, TypeResolver r) => r -> ParamFilters -> ParamVariances -> FunctionType -> m () validatateFunctionType r fm vm (FunctionType as rs ps fa) = do - mapErrorsM_ checkCount $ group $ sort $ pValues ps - mapErrorsM_ checkHides $ pValues ps + mapCompilerM_ checkCount $ group $ sort $ pValues ps + mapCompilerM_ checkHides $ pValues ps paired <- processPairs alwaysPair ps fa let allFilters = Map.union fm (Map.fromList paired) expanded <- fmap concat $ processPairs (\n fs -> return $ zip (repeat n) fs) ps fa - mapErrorsM_ (checkFilterType allFilters) expanded - mapErrorsM_ checkFilterVariance expanded - mapErrorsM_ (checkArg allFilters) $ pValues as - mapErrorsM_ (checkReturn allFilters) $ pValues rs + mapCompilerM_ (checkFilterType allFilters) expanded + mapCompilerM_ checkFilterVariance expanded + mapCompilerM_ (checkArg allFilters) $ pValues as + mapCompilerM_ (checkReturn allFilters) $ pValues rs where allVariances = Map.union vm (Map.fromList $ zip (pValues ps) (repeat Invariant)) checkCount xa@(x:_:_) = @@ -98,18 +98,18 @@ r -> ParamFilters -> ParamValues -> Positional GeneralInstance -> FunctionType -> m FunctionType assignFunctionParams r fm pm ts (FunctionType as rs ps fa) = do - mapErrorsM_ (validateGeneralInstance r fm) $ pValues ts + mapCompilerM_ (validateGeneralInstance r fm) $ pValues ts assigned <- fmap Map.fromList $ processPairs alwaysPair ps ts let pa = pm `Map.union` assigned - fa' <- fmap Positional $ mapErrorsM (assignFilters pa) (pValues fa) + fa' <- fmap Positional $ mapCompilerM (assignFilters pa) (pValues fa) processPairs_ (validateAssignment r fm) ts fa' as' <- fmap Positional $ - mapErrorsM (uncheckedSubValueType $ getValueForParam pa) (pValues as) + mapCompilerM (uncheckedSubValueType $ getValueForParam pa) (pValues as) rs' <- fmap Positional $ - mapErrorsM (uncheckedSubValueType $ getValueForParam pa) (pValues rs) + mapCompilerM (uncheckedSubValueType $ getValueForParam pa) (pValues rs) return $ FunctionType as' rs' (Positional []) (Positional []) where - assignFilters fm2 fs = mapErrorsM (uncheckedSubFilter $ getValueForParam fm2) fs + assignFilters fm2 fs = mapCompilerM (uncheckedSubFilter $ getValueForParam fm2) fs checkFunctionConvert :: (CollectErrorsM m, TypeResolver r) => r -> ParamFilters -> ParamValues -> FunctionType -> FunctionType -> m () diff --git a/src/Types/Procedure.hs b/src/Types/Procedure.hs --- a/src/Types/Procedure.hs +++ b/src/Types/Procedure.hs @@ -166,6 +166,7 @@ LoopBreak [c] | LoopContinue [c] | FailCall [c] (Expression c) | + RawFailCall String | IgnoreValues [c] (Expression c) | Assignment [c] (Positional (Assignable c)) (Expression c) | NoValueExpression [c] (VoidExpression c) | @@ -184,6 +185,7 @@ getStatementContext (LoopBreak c) = c getStatementContext (LoopContinue c) = c getStatementContext (FailCall c _) = c +getStatementContext (RawFailCall _) = [] getStatementContext (IgnoreValues c _) = c getStatementContext (Assignment c _ _) = c getStatementContext (NoValueExpression c _) = c diff --git a/src/Types/TypeCategory.hs b/src/Types/TypeCategory.hs --- a/src/Types/TypeCategory.hs +++ b/src/Types/TypeCategory.hs @@ -86,7 +86,7 @@ import Control.Arrow (second) import Control.Monad ((>=>),when) -import Data.List (group,groupBy,intercalate,nub,sort,sortBy) +import Data.List (group,groupBy,intercalate,nub,nubBy,sort,sortBy) import qualified Data.Map as Map import qualified Data.Set as Set @@ -343,7 +343,7 @@ ps2 <- case n2 `Map.lookup` pa of (Just x) -> return x _ -> compilerErrorM $ "Category " ++ show n1 ++ " does not refine " ++ show n2 - fmap Positional $ mapErrorsM (subAllParams assigned) $ pValues ps2 + fmap Positional $ mapCompilerM (subAllParams assigned) $ pValues ps2 trDefines (CategoryResolver tm) (TypeInstance n1 ps1) n2 = do (_,t) <- getValueCategory tm ([],n1) let params = map vpParam $ getCategoryParams t @@ -352,7 +352,7 @@ ps2 <- case n2 `Map.lookup` pa of (Just x) -> return x _ -> compilerErrorM $ "Category " ++ show n1 ++ " does not define " ++ show n2 - fmap Positional $ mapErrorsM (subAllParams assigned) $ pValues ps2 + fmap Positional $ mapCompilerM (subAllParams assigned) $ pValues ps2 trVariance (CategoryResolver tm) n = do (_,t) <- getCategory tm ([],n) return $ Positional $ map vpVariance $ getCategoryParams t @@ -392,16 +392,16 @@ AnyCategory c -> Positional GeneralInstance -> m (Positional [TypeFilter]) checkFilters t ps = do assigned <- fmap (Map.insert ParamSelf selfType . Map.fromList) $ processPairs alwaysPair (Positional params) ps - fs <- mapErrorsM (subSingleFilter assigned . \f -> (pfParam f,pfFilter f)) allFilters + fs <- mapCompilerM (subSingleFilter assigned . \f -> (pfParam f,pfFilter f)) allFilters let fa = Map.fromListWith (++) $ map (second (:[])) fs - fmap Positional $ mapErrorsM (assignFilter fa) params where + fmap Positional $ mapCompilerM (assignFilter fa) params where params = map vpParam $ getCategoryParams t allFilters = getCategoryFilters t ++ map (ParamFilter (getCategoryContext t) ParamSelf) (getSelfFilters t) subSingleFilter pa (n,(TypeFilter v t2)) = do t3<- uncheckedSubInstance (getValueForParam pa) t2 return (n,(TypeFilter v t3)) subSingleFilter pa (n,(DefinesFilter (DefinesInstance n2 ps2))) = do - ps3 <- mapErrorsM (uncheckedSubInstance $ getValueForParam pa) (pValues ps2) + ps3 <- mapCompilerM (uncheckedSubInstance $ getValueForParam pa) (pValues ps2) return (n,(DefinesFilter (DefinesInstance n2 (Positional ps3)))) assignFilter fa n = case n `Map.lookup` fa of @@ -446,8 +446,8 @@ if isValueInterface t || isValueConcrete t then return (c2,t) else compilerErrorM $ "Category " ++ show n ++ - " cannot be used as a value" ++ - formatFullContextBrace c + " cannot be used as a value" ++ + formatFullContextBrace c getInstanceCategory :: (Show c, CollectErrorsM m) => CategoryMap c -> ([c],CategoryName) -> m ([c],AnyCategory c) @@ -456,8 +456,8 @@ if isInstanceInterface t then return (c2,t) else compilerErrorM $ "Category " ++ show n ++ - " cannot be used as a type interface" ++ - formatFullContextBrace c + " cannot be used as a type interface" ++ + formatFullContextBrace c getConcreteCategory :: (Show c, CollectErrorsM m) => CategoryMap c -> ([c],CategoryName) -> m ([c],AnyCategory c) @@ -466,8 +466,8 @@ if isValueConcrete t then return (c2,t) else compilerErrorM $ "Category " ++ show n ++ - " cannot be used as concrete" ++ - formatFullContextBrace c + " cannot be used as concrete" ++ + formatFullContextBrace c includeNewTypes :: (Show c, CollectErrorsM m) => CategoryMap c -> [AnyCategory c] -> m (CategoryMap c) @@ -493,7 +493,7 @@ getFilterMap :: CollectErrorsM m => [ValueParam c] -> [ParamFilter c] -> m ParamFilters getFilterMap ps fs = do - mirrored <- fmap concat $ mapErrorsM maybeMirror fs + mirrored <- fmap concat $ mapCompilerM maybeMirror fs return $ getFilters mirrored $ zip (Set.toList pa) (repeat []) where pa = Set.fromList $ map vpParam ps maybeMirror fa@(ParamFilter c p1 (TypeFilter d p2)) = do @@ -522,11 +522,11 @@ Map.fromList $ zip ps (map (singleType . JustParamName False) ps) ++ [(ParamSelf,selfType)] disallowBoundedParams :: CollectErrorsM m => ParamFilters -> m () -disallowBoundedParams = mapErrorsM_ checkBounds . Map.toList where +disallowBoundedParams = mapCompilerM_ checkBounds . Map.toList where checkBounds (p,fs) = do let (lb,ub) = foldr splitBounds (minBound,maxBound) fs when (lb /= minBound && ub /= maxBound) $ - ("Param " ++ show p ++ " cannot have both lower and upper bounds") !!> + "Param " ++ show p ++ " cannot have both lower and upper bounds" !!> collectAllM_ [ compilerErrorM $ "Lower bound: " ++ show lb, compilerErrorM $ "Upper bound: " ++ show ub @@ -543,14 +543,14 @@ where checkSingle tm (ValueInterface c _ n _ rs _ _) = do let ts2 = map (\r -> (vrContext r,tiName $ vrType r)) rs - is <- mapErrorsM (getCategory tm) ts2 + is <- mapCompilerM (getCategory tm) ts2 collectAllM_ (map (valueRefinesInstanceError c n) is) collectAllM_ (map (valueRefinesConcreteError c n) is) checkSingle tm (ValueConcrete c _ n _ rs ds _ _) = do let ts2 = map (\r -> (vrContext r,tiName $ vrType r)) rs let ts3 = map (\d -> (vdContext d,diName $ vdType d)) ds - is1 <- mapErrorsM (getCategory tm) ts2 - is2 <- mapErrorsM (getCategory tm) ts3 + is1 <- mapCompilerM (getCategory tm) ts2 + is2 <- mapCompilerM (getCategory tm) ts3 collectAllM_ (map (concreteRefinesInstanceError c n) is1) collectAllM_ (map (concreteDefinesValueError c n) is2) collectAllM_ (map (concreteRefinesConcreteError c n) is1) @@ -559,40 +559,40 @@ valueRefinesInstanceError c n (c2,t) | isInstanceInterface t = compilerErrorM $ "Value interface " ++ show n ++ formatFullContextBrace c ++ - " cannot refine type interface " ++ - show (iiName t) ++ formatFullContextBrace c2 + " cannot refine type interface " ++ + show (iiName t) ++ formatFullContextBrace c2 | otherwise = return () valueRefinesConcreteError c n (c2,t) | isValueConcrete t = compilerErrorM $ "Value interface " ++ show n ++ formatFullContextBrace c ++ - " cannot refine concrete type " ++ - show (getCategoryName t) ++ formatFullContextBrace c2 + " cannot refine concrete type " ++ + show (getCategoryName t) ++ formatFullContextBrace c2 | otherwise = return () concreteRefinesInstanceError c n (c2,t) | isInstanceInterface t = compilerErrorM $ "Concrete type " ++ show n ++ formatFullContextBrace c ++ - " cannot refine instance interface " ++ - show (getCategoryName t) ++ formatFullContextBrace c2 ++ - " => use defines instead" + " cannot refine instance interface " ++ + show (getCategoryName t) ++ formatFullContextBrace c2 ++ + " => use defines instead" | otherwise = return () concreteDefinesValueError c n (c2,t) | isValueInterface t = compilerErrorM $ "Concrete type " ++ show n ++ formatFullContextBrace c ++ - " cannot define value interface " ++ - show (getCategoryName t) ++ formatFullContextBrace c2 ++ - " => use refines instead" + " cannot define value interface " ++ + show (getCategoryName t) ++ formatFullContextBrace c2 ++ + " => use refines instead" | otherwise = return () concreteRefinesConcreteError c n (c2,t) | isValueConcrete t = compilerErrorM $ "Concrete type " ++ show n ++ formatFullContextBrace c ++ - " cannot refine concrete type " ++ - show (getCategoryName t) ++ formatFullContextBrace c2 + " cannot refine concrete type " ++ + show (getCategoryName t) ++ formatFullContextBrace c2 | otherwise = return () concreteDefinesConcreteError c n (c2,t) | isValueConcrete t = compilerErrorM $ "Concrete type " ++ show n ++ formatFullContextBrace c ++ - " cannot define concrete type " ++ - show (getCategoryName t) ++ formatFullContextBrace c2 + " cannot define concrete type " ++ + show (getCategoryName t) ++ formatFullContextBrace c2 | otherwise = return () checkConnectionCycles :: (Show c, CollectErrorsM m) => @@ -602,27 +602,27 @@ checker us (ValueInterface c _ n _ rs _ _) = do failIfCycle n c us let ts2 = map (\r -> (vrContext r,tiName $ vrType r)) rs - is <- mapErrorsM (getValueCategory tm) ts2 + is <- mapCompilerM (getValueCategory tm) ts2 collectAllM_ (map (checker (us ++ [n]) . snd) is) checker us (ValueConcrete c _ n _ rs _ _ _) = do failIfCycle n c us let ts2 = map (\r -> (vrContext r,tiName $ vrType r)) rs - is <- mapErrorsM (getValueCategory tm) ts2 + is <- mapCompilerM (getValueCategory tm) ts2 collectAllM_ (map (checker (us ++ [n]) . snd) is) checker _ _ = return () failIfCycle n c us = when (n `Set.member` (Set.fromList us)) $ compilerErrorM $ "Category " ++ show n ++ formatFullContextBrace c ++ - " refers back to itself: " ++ - intercalate " -> " (map show (us ++ [n])) + " refers back to itself: " ++ + intercalate " -> " (map show (us ++ [n])) checkParamVariances :: (Show c, CollectErrorsM m) => CategoryMap c -> [AnyCategory c] -> m () checkParamVariances tm0 ts = do tm <- declareAllTypes tm0 ts let r = CategoryResolver tm - mapErrorsM_ (checkCategory r) ts - mapErrorsM_ checkBounds ts + mapCompilerM_ (checkCategory r) ts + mapCompilerM_ checkBounds ts where categoryContext t = "In " ++ show (getCategoryName t) ++ formatFullContextBrace (getCategoryContext t) @@ -631,49 +631,49 @@ noDuplicates c n ps let vm = Map.fromList $ map (\p -> (vpParam p,vpVariance p)) ps collectAllM_ (map (checkRefine r vm) rs) - mapErrorsM_ (checkFilterVariance r vm) fa + mapCompilerM_ (checkFilterVariance r vm) fa checkCategory r t@(ValueConcrete c _ n ps rs ds fa _) = categoryContext t ??> do noDuplicates c n ps let vm = Map.fromList $ map (\p -> (vpParam p,vpVariance p)) ps collectAllM_ (map (checkRefine r vm) rs) collectAllM_ (map (checkDefine r vm) ds) - mapErrorsM_ (checkFilterVariance r vm) fa + mapCompilerM_ (checkFilterVariance r vm) fa checkCategory r t@(InstanceInterface c _ n ps fa _) = categoryContext t ??> do noDuplicates c n ps let vm = Map.fromList $ map (\p -> (vpParam p,vpVariance p)) ps - mapErrorsM_ (checkFilterVariance r vm) fa + mapCompilerM_ (checkFilterVariance r vm) fa noDuplicates c n ps = collectAllM_ (map checkCount $ group $ sort $ map vpParam ps) where checkCount xa@(x:_:_) = compilerErrorM $ "Param " ++ show x ++ " occurs " ++ show (length xa) ++ - " times in " ++ show n ++ formatFullContextBrace c + " times in " ++ show n ++ formatFullContextBrace c checkCount _ = return () checkRefine r vm (ValueRefine c t) = validateInstanceVariance r vm Covariant (singleType $ JustTypeInstance t) do + "In filter " ++ show n ++ " " ++ show f ++ formatFullContextBrace c ??> do case n `Map.lookup` vs of Just Contravariant -> compilerErrorM $ "Contravariant param " ++ show n ++ - " cannot have a requires filter" + " cannot have a requires filter" Nothing -> compilerErrorM $ "Param " ++ show n ++ " is undefined" _ -> return () validateInstanceVariance r vs Contravariant t checkFilterVariance r vs (ParamFilter c n f@(TypeFilter FilterAllows t)) = - ("In filter " ++ show n ++ " " ++ show f ++ formatFullContextBrace c) ??> do + "In filter " ++ show n ++ " " ++ show f ++ formatFullContextBrace c ??> do case n `Map.lookup` vs of Just Covariant -> compilerErrorM $ "Covariant param " ++ show n ++ - " cannot have an allows filter" + " cannot have an allows filter" Nothing -> compilerErrorM $ "Param " ++ show n ++ " is undefined" _ -> return () validateInstanceVariance r vs Covariant t checkFilterVariance r vs (ParamFilter c n f@(DefinesFilter t)) = - ("In filter " ++ show n ++ " " ++ show f ++ formatFullContextBrace c) ??> do + "In filter " ++ show n ++ " " ++ show f ++ formatFullContextBrace c ??> do case n `Map.lookup` vs of Just Contravariant -> compilerErrorM $ "Contravariant param " ++ show n ++ - " cannot have a defines filter" + " cannot have a defines filter" Nothing -> compilerErrorM $ "Param " ++ show n ++ " is undefined" _ -> return () validateDefinesVariance r vs Contravariant t @@ -683,28 +683,28 @@ checkCategoryInstances tm0 ts = do tm <- declareAllTypes tm0 ts let r = CategoryResolver tm - mapErrorsM_ (checkSingle r) ts + mapCompilerM_ (checkSingle r) ts where checkSingle r t = do let pa = Set.fromList $ map vpParam $ getCategoryParams t fm <- getCategoryFilterMap t - mapErrorsM_ (checkFilterParam pa) (getCategoryFilters t) - mapErrorsM_ (checkRefine r fm) (getCategoryRefines t) - mapErrorsM_ (checkDefine r fm) (getCategoryDefines t) - mapErrorsM_ (checkFilter r fm) (getCategoryFilters t) - mapErrorsM_ (validateCategoryFunction r t) (getCategoryFunctions t) + mapCompilerM_ (checkFilterParam pa) (getCategoryFilters t) + mapCompilerM_ (checkRefine r fm) (getCategoryRefines t) + mapCompilerM_ (checkDefine r fm) (getCategoryDefines t) + mapCompilerM_ (checkFilter r fm) (getCategoryFilters t) + mapCompilerM_ (validateCategoryFunction r t) (getCategoryFunctions t) checkFilterParam pa (ParamFilter c n _) = when (not $ n `Set.member` pa) $ compilerErrorM $ "Param " ++ show n ++ formatFullContextBrace c ++ " not found" checkRefine r fm (ValueRefine c t) = validateTypeInstance r fm t r -> AnyCategory c -> ScopedFunction c -> m () @@ -734,8 +734,8 @@ if getCategoryName t `Set.member` ta then update tm ta ts2 else do - refines <- mapErrorsM (\r -> getCategory tm (vrContext r,tiName $ vrType r)) $ getCategoryRefines t - defines <- mapErrorsM (\d -> getCategory tm (vdContext d,diName $ vdType d)) $ getCategoryDefines t + refines <- mapCompilerM (\r -> getCategory tm (vrContext r,tiName $ vrType r)) $ getCategoryRefines t + defines <- mapCompilerM (\d -> getCategory tm (vdContext d,diName $ vdType d)) $ getCategoryDefines t (ts3,ta2) <- update tm (getCategoryName t `Set.insert` ta) (map snd $ refines ++ defines) (ts4,ta3) <- update tm ta2 ts2 return (ts3 ++ [t] ++ ts4,ta3) @@ -784,12 +784,12 @@ noDuplicateCategories :: (Show c, Show a, CollectErrorsM m) => [c] -> CategoryName -> [(CategoryName,a)] -> m () noDuplicateCategories c n ns = - mapErrorsM_ checkCount $ groupBy (\x y -> fst x == fst y) $ + mapCompilerM_ checkCount $ groupBy (\x y -> fst x == fst y) $ sortBy (\x y -> fst x `compare` fst y) ns where checkCount xa@(x:_:_) = compilerErrorM $ "Category " ++ show (fst x) ++ " occurs " ++ show (length xa) ++ - " times in " ++ show n ++ formatFullContextBrace c ++ " :\n---\n" ++ - intercalate "\n---\n" (map (show . snd) xa) + " times in " ++ show n ++ formatFullContextBrace c ++ " :\n---\n" ++ + intercalate "\n---\n" (map (show . snd) xa) checkCount _ = return () flattenAllConnections :: (Show c, CollectErrorsM m) => @@ -806,22 +806,22 @@ t' <- preMergeSingle tm t return $ Map.insert (getCategoryName t') t' tm preMergeSingle tm (ValueInterface c ns n ps rs vs fs) = do - rs' <- fmap concat $ mapErrorsM (getRefines tm) rs + rs' <- fmap concat $ mapCompilerM (getRefines tm) rs return $ ValueInterface c ns n ps rs' vs fs preMergeSingle tm (ValueConcrete c ns n ps rs ds vs fs) = do - rs' <- fmap concat $ mapErrorsM (getRefines tm) rs + rs' <- fmap concat $ mapCompilerM (getRefines tm) rs return $ ValueConcrete c ns n ps rs' ds vs fs preMergeSingle _ t = return t update r t u = do (ts2,tm) <- u t' <- updateSingle r tm t (tiName $ vrType t,t)) rs - mapErrorsM_ (\t -> checkConvert r fm (tiName (vrType t) `Map.lookup` rm) t) rs2 + mapCompilerM_ (\t -> checkConvert r fm (tiName (vrType t) `Map.lookup` rm) t) rs2 checkConvert r fm (Just ta1@(ValueRefine _ t1)) ta2@(ValueRefine _ t2) = do noInferredTypes $ checkGeneralMatch r fm Covariant (singleType $ JustTypeInstance t1) (singleType $ JustTypeInstance t2) CategoryMap c -> ParamValues -> ParamFilters -> [ValueRefine c] -> [ValueDefine c] -> [ScopedFunction c] -> m [ScopedFunction c] mergeFunctions r tm pm fm rs ds fs = do - inheritValue <- fmap concat $ mapErrorsM (getRefinesFuncs tm) rs - inheritType <- fmap concat $ mapErrorsM (getDefinesFuncs tm) ds - let inheritByName = Map.fromListWith (++) $ map (\f -> (sfName f,[f])) $ inheritValue ++ inheritType + inheritValue <- fmap concat $ mapCompilerM (getRefinesFuncs tm) rs + inheritType <- fmap concat $ mapCompilerM (getDefinesFuncs tm) ds + let inheritByName = fmap (nubBy sameFunction) $ Map.fromListWith (++) $ map (\f -> (sfName f,[f])) $ inheritValue ++ inheritType let explicitByName = Map.fromListWith (++) $ map (\f -> (sfName f,[f])) fs let allNames = Set.toList $ Set.union (Map.keysSet inheritByName) (Map.keysSet explicitByName) - mapErrorsM (mergeByName r fm inheritByName explicitByName) allNames where + mapCompilerM (mergeByName r fm inheritByName explicitByName) allNames where getRefinesFuncs tm2 (ValueRefine c (TypeInstance n ts2)) = do (_,t) <- getValueCategory tm2 (c,n) let ps = map vpParam $ getCategoryParams t let fs2 = getCategoryFunctions t paired <- processPairs alwaysPair (Positional ps) ts2 let assigned = Map.fromList $ (ParamSelf,selfType):paired - mapErrorsM (unfixedSubFunction assigned) fs2 + mapCompilerM (unfixedSubFunction assigned) fs2 getDefinesFuncs tm2 (ValueDefine c (DefinesInstance n ts2)) = do (_,t) <- getInstanceCategory tm2 (c,n) let ps = map vpParam $ getCategoryParams t let fs2 = getCategoryFunctions t paired <- processPairs alwaysPair (Positional ps) ts2 let assigned = Map.fromList $ (ParamSelf,selfType):paired - mapErrorsM (unfixedSubFunction assigned) fs2 + mapCompilerM (unfixedSubFunction assigned) fs2 mergeByName r2 fm2 im em n = tryMerge r2 fm2 n (n `Map.lookup` im) (n `Map.lookup` em) -- Inherited without an override. @@ -907,7 +907,7 @@ intercalate "\n---\n" (map show es) | otherwise = do let ff@(ScopedFunction c n2 t s as rs2 ps fa ms) = head es - mapErrorsM_ (checkMerge r2 fm2 ff) is + mapCompilerM_ (checkMerge r2 fm2 ff) is return $ ScopedFunction c n2 t s as rs2 ps fa (ms ++ is) where checkMerge r3 fm3 f1 f2 @@ -916,8 +916,7 @@ show (sfScope f1) ++ " in function merge:\n---\n" ++ show f2 ++ "\n ->\n" ++ show f1 | otherwise = - ("In function merge:\n---\n" ++ show f2 ++ - "\n ->\n" ++ show f1 ++ "\n---\n") ??> do + "In function merge:\n---\n" ++ show f2 ++ "\n ->\n" ++ show f1 ++ "\n---\n" ??> do f1' <- parsedToFunctionType f1 f2' <- parsedToFunctionType f2 checkFunctionConvert r3 fm3 pm f2' f1' @@ -957,6 +956,10 @@ instance Show c => Show (ScopedFunction c) where show f = showFunctionInContext (show (sfScope f) ++ " ") "" f +sameFunction :: ScopedFunction c -> ScopedFunction c -> Bool +sameFunction (ScopedFunction _ n1 t1 s1 _ _ _ _ _) (ScopedFunction _ n2 t2 s2 _ _ _ _ _) = + all id [n1 == n2, t1 == t2, s1 == s2] + showFunctionInContext :: Show c => String -> String -> ScopedFunction c -> String showFunctionInContext s indent (ScopedFunction cs n t _ as rs ps fa ms) = indent ++ s ++ "/*" ++ show t ++ "*/ " ++ show n ++ @@ -991,7 +994,7 @@ let as' = Positional $ map pvType $ pValues as let rs' = Positional $ map pvType $ pValues rs let ps' = Positional $ map vpParam $ pValues ps - mapErrorsM_ checkFilter fa + mapCompilerM_ checkFilter fa let fm = Map.fromListWith (++) $ map (\f -> (pfParam f,[pfFilter f])) fa let fa' = Positional $ map (getFilters fm) $ pValues ps' return $ FunctionType as' rs' ps' fa' @@ -1000,8 +1003,8 @@ checkFilter f = when (not $ (pfParam f) `Set.member` pa) $ compilerErrorM $ "Filtered param " ++ show (pfParam f) ++ - " is not defined for function " ++ show n ++ - formatFullContextBrace c + " is not defined for function " ++ show n ++ + formatFullContextBrace c getFilters fm2 n2 = case n2 `Map.lookup` fm2 of (Just fs) -> fs @@ -1014,13 +1017,13 @@ unfixedSubFunction :: (Show c, CollectErrorsM m) => ParamValues -> ScopedFunction c -> m (ScopedFunction c) unfixedSubFunction pa ff@(ScopedFunction c n t s as rs ps fa ms) = - ("In function:\n---\n" ++ show ff ++ "\n---\n") ??> do + "In function:\n---\n" ++ show ff ++ "\n---\n" ??> do let unresolved = Map.fromList $ map (\n2 -> (n2,singleType $ JustParamName False n2)) $ map vpParam $ pValues ps let pa' = pa `Map.union` unresolved - as' <- fmap Positional $ mapErrorsM (subPassed pa') $ pValues as - rs' <- fmap Positional $ mapErrorsM (subPassed pa') $ pValues rs - fa' <- mapErrorsM (subFilter pa') fa - ms' <- mapErrorsM (uncheckedSubFunction pa) ms + as' <- fmap Positional $ mapCompilerM (subPassed pa') $ pValues as + rs' <- fmap Positional $ mapCompilerM (subPassed pa') $ pValues rs + fa' <- mapCompilerM (subFilter pa') fa + ms' <- mapCompilerM (uncheckedSubFunction pa) ms return $ (ScopedFunction c n t s as' rs' ps fa' ms') where subPassed pa2 (PassedValue c2 t2) = do @@ -1033,11 +1036,11 @@ replaceSelfFunction :: (Show c, CollectErrorsM m) => GeneralInstance -> ScopedFunction c -> m (ScopedFunction c) replaceSelfFunction self ff@(ScopedFunction c n t s as rs ps fa ms) = - ("In function:\n---\n" ++ show ff ++ "\n---\n") ??> do - as' <- fmap Positional $ mapErrorsM subPassed $ pValues as - rs' <- fmap Positional $ mapErrorsM subPassed $ pValues rs - fa' <- mapErrorsM subFilter fa - ms' <- mapErrorsM (replaceSelfFunction self) ms + "In function:\n---\n" ++ show ff ++ "\n---\n" ??> do + as' <- fmap Positional $ mapCompilerM subPassed $ pValues as + rs' <- fmap Positional $ mapCompilerM subPassed $ pValues rs + fa' <- mapCompilerM subFilter fa + ms' <- mapCompilerM (replaceSelfFunction self) ms return $ (ScopedFunction c n t s as' rs' ps fa' ms') where subPassed (PassedValue c2 t2) = do @@ -1063,8 +1066,8 @@ r -> ParamFilters -> ParamValues -> [PatternMatch ValueType] -> m (MergeTree InferredTypeGuess) inferParamTypes r f ps ts = do - ts2 <- mapErrorsM subAll ts - fmap mergeAll $ mapErrorsM matchPattern ts2 where + ts2 <- mapCompilerM subAll ts + fmap mergeAll $ mapCompilerM matchPattern ts2 where subAll (PatternMatch v t1 t2) = do t2' <- uncheckedSubValueType (getValueForParam ps) t2 return (PatternMatch v t1 t2') @@ -1097,7 +1100,7 @@ m [InferredTypeGuess] mergeInferredTypes r f ff ps gs0 = do let gs0' = mapTypeGuesses gs0 - mapErrorsM reduce $ Map.toList gs0' where + mapCompilerM reduce $ Map.toList gs0' where reduce (i,is) = do (GuessUnion gs) <- reduceMergeTree anyOp allOp leafOp is >>= filterGuesses i t <- takeBest i gs @@ -1168,12 +1171,11 @@ (True,_,_) -> return lo (_,True,False) -> return lo (_,False,True) -> return hi - _ -> compilerErrorM (show g) compilerErrorM (show g) collectAllM_ [checkLo,checkHi] >> compilerErrorM "" + (True,True) -> collectAllM_ [checkLo,checkHi] >> emptyErrorM (True,_) -> return $ GuessRange hi hi (_,True) -> return $ GuessRange lo lo _ -> return $ GuessRange lo hi @@ -1192,8 +1194,8 @@ when (not loP) $ checkSubFilters i lo when (not hiP) $ checkSubFilters i hi return g - checkSubFilters i t = ("In guess " ++ show t ++ " for param " ++ show i) ??> do + checkSubFilters i t = "In guess " ++ show t ++ " for param " ++ show i ??> do let ps' = Map.insert i t ps fs <- ff `filterLookup` i - fs' <- mapErrorsM (uncheckedSubFilter (getValueForParam ps'))fs + fs' <- mapCompilerM (uncheckedSubFilter (getValueForParam ps')) fs validateAssignment r f t fs' diff --git a/src/Types/TypeInstance.hs b/src/Types/TypeInstance.hs --- a/src/Types/TypeInstance.hs +++ b/src/Types/TypeInstance.hs @@ -338,7 +338,7 @@ noInferredTypes g = do g' <- g let gm = mapTypeGuesses g' - "Type inference is not allowed here" !!> (mapErrorsM_ format $ Map.elems gm) where + "Type inference is not allowed here" !!> mapCompilerM_ format (Map.elems gm) where format = compilerErrorM . reduceMergeTree showAny showAll show showAny gs = "Any of [ " ++ intercalate ", " gs ++ " ]" showAll gs = "All of [ " ++ intercalate ", " gs ++ " ]" @@ -376,7 +376,7 @@ pairMergeTree mergeAnyM mergeAllM (checkSingleMatch r f Covariant) t1 t2 matchInferredRight = matchOnlyLeaf t2 >>= inferFrom inferFrom (JustInferredType p) = return $ mergeLeaf $ InferredTypeGuess p t1 v - inferFrom _ = compilerErrorM "" + inferFrom _ = emptyErrorM bothSingle = do t1' <- matchOnlyLeaf t1 t2' <- matchOnlyLeaf t2 @@ -428,7 +428,7 @@ checkParamToInstance r f v@Contravariant n1 t2@(TypeInstance _ _) = do cs2 <- fmap (filter isTypeFilter) $ f `filterLookup` n1 mergeAnyM (map checkConstraintToInstance cs2) x implies T -> x only if T -> F @@ -440,7 +440,7 @@ checkParamToInstance r f v@Covariant n1 t2@(TypeInstance _ _) = do cs1 <- fmap (filter isTypeFilter) $ f `filterLookup` n1 mergeAnyM (map checkConstraintToInstance cs1) " ++ show t2 ++ " in " ++ show v ++ " contexts") + "No filters imply " ++ show n1 ++ " -> " ++ show t2 ++ " in " ++ show v ++ " contexts" where checkConstraintToInstance (TypeFilter FilterRequires t) = -- x -> F implies x -> T only if F -> T @@ -462,7 +462,7 @@ checkInstanceToParam r f v@Contravariant t1@(TypeInstance _ _) n2 = do cs1 <- fmap (filter isTypeFilter) $ f `filterLookup` n2 mergeAnyM (map checkInstanceToConstraint cs1) F implies x -> T only if F -> T @@ -475,7 +475,7 @@ checkInstanceToParam r f v@Covariant t1@(TypeInstance _ _) n2 = do cs2 <- fmap (filter isTypeFilter) $ f `filterLookup` n2 mergeAnyM (map checkInstanceToConstraint cs2) " ++ show n2 ++ " in " ++ show v ++ " contexts") + "No filters imply " ++ show t1 ++ " -> " ++ show n2 ++ " in " ++ show v ++ " contexts" where checkInstanceToConstraint (TypeFilter FilterAllows t) = -- F -> x implies T -> x only if T -> F @@ -504,7 +504,7 @@ [(self1,c2) | c2 <- cs2] ++ [(c1,self2) | c1 <- cs1] mergeAnyM (map (\(c1,c2) -> checkConstraintToConstraint v c1 c2) typeFilters) " ++ show n2) + "No filters imply " ++ show n1 ++ " -> " ++ show n2 where selfParam1 = singleType $ JustParamName False n1 selfParam2 = singleType $ JustParamName False n2 @@ -553,14 +553,14 @@ validateTypeInstance r f t@(TypeInstance _ ps) = do fa <- trTypeFilters r t processPairs_ (validateAssignment r f) ps fa - mapErrorsM_ (validateGeneralInstance r f) (pValues ps) r -> ParamFilters -> DefinesInstance -> m () validateDefinesInstance r f t@(DefinesInstance _ ps) = do fa <- trDefinesFilters r t processPairs_ (validateAssignment r f) ps fa - mapErrorsM_ (validateGeneralInstance r f) (pValues ps) r -> ParamFilters -> TypeFilter -> m () @@ -569,14 +569,14 @@ validateAssignment :: (CollectErrorsM m, TypeResolver r) => r -> ParamFilters -> GeneralInstance -> [TypeFilter] -> m () -validateAssignment r f t fs = mapErrorsM_ checkWithMessage fs where - checkWithMessage f2 = checkFilter t f2 validateInstanceVariance r vm' (v `composeVariance` v2) p) paired + mapCompilerM_ (\(v2,p) -> validateInstanceVariance r vm' (v `composeVariance` v2) p) paired validateSingle (JustParamName _ n) = case n `Map.lookup` vm' of Nothing -> compilerErrorM $ "Param " ++ show n ++ " is undefined" @@ -618,7 +618,7 @@ validateDefinesVariance r vm v (DefinesInstance n ps) = do vs <- trVariance r n paired <- processPairs alwaysPair vs ps - mapErrorsM_ (\(v2,p) -> validateInstanceVariance r vm' (v `composeVariance` v2) p) paired where + mapCompilerM_ (\(v2,p) -> validateInstanceVariance r vm' (v `composeVariance` v2) p) paired where vm' = Map.insert ParamSelf Covariant vm uncheckedSubValueType :: CollectErrorsM m => @@ -642,7 +642,7 @@ uncheckedSubSingle :: CollectErrorsM m => (ParamName -> m GeneralInstance) -> TypeInstance -> m TypeInstance uncheckedSubSingle replace (TypeInstance n (Positional ts)) = do - ts' <- mapErrorsM (uncheckedSubInstance replace) ts + ts' <- mapCompilerM (uncheckedSubInstance replace) ts return $ TypeInstance n (Positional ts') uncheckedSubFilter :: CollectErrorsM m => @@ -651,17 +651,17 @@ t' <- uncheckedSubInstance replace t return (TypeFilter d t') uncheckedSubFilter replace (DefinesFilter (DefinesInstance n ts)) = do - ts' <- mapErrorsM (uncheckedSubInstance replace) (pValues ts) + ts' <- mapCompilerM (uncheckedSubInstance replace) (pValues ts) return (DefinesFilter (DefinesInstance n (Positional ts'))) uncheckedSubFilters :: CollectErrorsM m => (ParamName -> m GeneralInstance) -> ParamFilters -> m ParamFilters uncheckedSubFilters replace fa = do - fa' <- mapErrorsM subParam $ Map.toList fa + fa' <- mapCompilerM subParam $ Map.toList fa return $ Map.fromList fa' where subParam (n,fs) = do - fs' <- mapErrorsM (uncheckedSubFilter replace) fs + fs' <- mapCompilerM (uncheckedSubFilter replace) fs return (n,fs') replaceSelfValueType :: CollectErrorsM m => @@ -683,7 +683,7 @@ replaceSelfSingle :: CollectErrorsM m => GeneralInstance -> TypeInstance -> m TypeInstance replaceSelfSingle self (TypeInstance n (Positional ts)) = do - ts' <- mapErrorsM (replaceSelfInstance self) ts + ts' <- mapCompilerM (replaceSelfInstance self) ts return $ TypeInstance n (Positional ts') replaceSelfFilter :: CollectErrorsM m => @@ -692,5 +692,5 @@ t' <- replaceSelfInstance self t return (TypeFilter d t') replaceSelfFilter self (DefinesFilter (DefinesInstance n ts)) = do - ts' <- mapErrorsM (replaceSelfInstance self) (pValues ts) + ts' <- mapCompilerM (replaceSelfInstance self) (pValues ts) return (DefinesFilter (DefinesInstance n (Positional ts'))) diff --git a/tests/builtin-types.0rt b/tests/builtin-types.0rt --- a/tests/builtin-types.0rt +++ b/tests/builtin-types.0rt @@ -232,27 +232,30 @@ } -testcase "reduce ReadPosition" { +testcase "interface implementations" { success } -unittest success { - if (!present(reduce,ReadPosition>("x"))) { - fail("Failed") - } +unittest boolDefault { + \ Testing.checkEquals(Bool.default(),false) } -unittest failure { - if (present(reduce,ReadPosition>("x"))) { - fail("Failed") - } +unittest charDefault { + \ Testing.checkEquals(Char.default(),'\000') } +unittest floatDefault { + \ Testing.checkEquals(Float.default(),0.0) +} -testcase "interface implementations" { - success +unittest intDefault { + \ Testing.checkEquals(Int.default(),0) } +unittest stringDefault { + \ Testing.checkEquals(String.default(),"") +} + unittest stringLessThan { if (!("x" `String.lessThan` "y")) { fail("Failed") @@ -272,7 +275,7 @@ } unittest stringBuilder { - Builder builder <- String.builder() + [Append&Build] builder <- String.builder() \ Testing.checkEquals(builder.build(),"") \ Testing.checkEquals(builder.append("xyz").build(),"xyz") \ Testing.checkEquals(builder.append("123").build(),"xyz123") @@ -427,7 +430,7 @@ if (!present(strong(value2))) { fail("Failed") } - Builder builder <- String.builder().append(require(value1)) + [Append&Build] builder <- String.builder().append(require(value1)) value1 <- empty if (present(strong(value2))) { fail("Failed") @@ -436,11 +439,11 @@ unittest simpleAccess { String s <- "abcde" - Char c <- s.readPosition(3) + Char c <- s.readAt(3) if (c != 'd') { fail(c) } - Int size <- s.readSize() + Int size <- s.size() if (size != 5) { fail(size) } @@ -466,7 +469,7 @@ if ("abc\x00def" == "abc") { fail("Failed") } - if (("abc\x00def").readPosition(4) != 'd') { + if (("abc\x00def").readAt(4) != 'd') { fail("Failed") } } @@ -484,7 +487,7 @@ define Test { run () { - \ ("abc").readPosition(-10) + \ ("abc").readAt(-10) } } @@ -505,7 +508,7 @@ define Test { run () { - \ ("abc").readPosition(100) + \ ("abc").readAt(100) } } diff --git a/tests/cli-tests.sh b/tests/cli-tests.sh --- a/tests/cli-tests.sh +++ b/tests/cli-tests.sh @@ -312,12 +312,6 @@ } -test_example_tree() { - do_zeolite -p "$ZEOLITE_PATH" -I lib/util -m TreeDemo example/tree -f - do_zeolite -p "$ZEOLITE_PATH" -t example/tree -} - - test_example_parser() { do_zeolite -p "$ZEOLITE_PATH" -r example/parser -f do_zeolite -p "$ZEOLITE_PATH" -t example/parser @@ -374,7 +368,6 @@ test_bad_system_include test_global_include test_example_hello - test_example_tree test_example_parser ) diff --git a/tests/regressions.0rt b/tests/regressions.0rt --- a/tests/regressions.0rt +++ b/tests/regressions.0rt @@ -22,7 +22,7 @@ } unittest test { - \ empty + \ Type2.call() } concrete Type1<#x> { @@ -84,6 +84,38 @@ define Child { call1 (_) {} call2 (_) {} +} + +testcase "Issue #73 is not re-broken by #self" { + // https://github.com/ta0kira/zeolite/issues/73 + success +} + +unittest test { + \ Type2.call() +} + +concrete Type1<|#x> { + @type create<#y> () -> (#self) +} + +define Type1 { + create () { + return #self{ } + } +} + +concrete Type2<#y> { + @type call () -> () +} + +define Type2 { + call () { + // Type1<#y> is substituted in for #self, putting #y in the return type. + // This is a different #y than create's own #y, and so it should not be + // substituted with Int. + Type1<#y> value <- Type1<#y>.create() + } } diff --git a/tests/self-type.0rt b/tests/self-type.0rt --- a/tests/self-type.0rt +++ b/tests/self-type.0rt @@ -16,7 +16,7 @@ // Author: Kevin P. Barry [ta0kira@gmail.com] -testcase "disallowed in @category functions" { +testcase "#self disallowed in @category functions" { error require "#self not found" } @@ -32,7 +32,7 @@ } -testcase "disallowed in @category members" { +testcase "#self disallowed in @category members" { error require "#self not found" } @@ -50,7 +50,7 @@ } -testcase "disallowed in @category procedures" { +testcase "#self disallowed in @category procedures" { error require "#self not found" } @@ -66,7 +66,7 @@ } -testcase "in @type functions" { +testcase "#self in @type functions" { success } @@ -85,7 +85,7 @@ } -testcase "as base for @type call" { +testcase "#self as base for @type call" { success } @@ -109,7 +109,7 @@ } -testcase "in @value functions" { +testcase "#self in @value functions" { success } @@ -133,7 +133,7 @@ } -testcase "in @value members" { +testcase "#self in @value members" { success } @@ -154,7 +154,7 @@ } -testcase "in local variables in @type procedures" { +testcase "#self in local variables in @type procedures" { success } @@ -174,7 +174,7 @@ } -testcase "in local variables in @value procedures" { +testcase "#self in local variables in @value procedures" { success } @@ -199,7 +199,7 @@ } -testcase "in local variables in scoped" { +testcase "#self in local variables in scoped" { success } @@ -220,7 +220,7 @@ } -testcase "in reduce" { +testcase "#self in reduce" { success } @@ -254,7 +254,7 @@ } -testcase "in typename" { +testcase "#self in typename" { success } @@ -273,7 +273,7 @@ } -testcase "with type inference" { +testcase "#self with type inference" { success } @@ -297,7 +297,7 @@ } -testcase "as an explicit function param" { +testcase "#self as an explicit function param" { success } @@ -331,7 +331,7 @@ } -testcase "nested in initializer type" { +testcase "#self nested in initializer type" { success } @@ -355,7 +355,7 @@ } -testcase "top level initializer type" { +testcase "#self as top-level initializer type" { success } @@ -374,15 +374,24 @@ } -testcase "preserves type in implementations" { +testcase "#self preserves type in implementations" { success } -unittest test { +unittest withConcrete { Type value <- Type.create() \ Testing.checkEquals(value.next().prev().prev().next().next().get(),1) } +unittest withIntersect { + [Cell&Forward&Reverse] value <- Type.create() + \ Testing.checkEquals(value.next().prev().prev().next().next().get(),1) +} + +@value interface Cell<|#x> { + get () -> (#x) +} + @value interface Forward { next () -> (#self) } @@ -392,11 +401,11 @@ } concrete Type { + refines Cell refines Forward refines Reverse @type create () -> (Type) - @value get () -> (Int) } define Type { @@ -422,12 +431,12 @@ } -testcase "preserves type in function param filter" { +testcase "#self preserves type in function param filters" { success } unittest test { - Type value <- Type.create() + Type value <- Helper.new() \ Testing.checkEquals((value `Advance.by` 3).get(),3) } @@ -435,6 +444,18 @@ next () -> (#self) } +concrete Helper { + @type new<#x> + #x defines Default + () -> (#x) +} + +define Helper { + new () { + return #x.default() + } +} + concrete Advance { @type by<#x> #x requires Forward @@ -456,15 +477,15 @@ concrete Type { refines Forward + defines Default - @type create () -> (Type) @value get () -> (Int) } define Type { @value Int num - create () { + default () { return Type{ 0 } } @@ -475,4 +496,84 @@ next () { return Type{ num+1 } } +} + + +testcase "#self at top level of param filter" { + compiles +} + +@value interface Base<#x> { + refines Formatted + #x allows #self +} + +@value interface Type1 { + refines Base +} + +@value interface Type2 { + refines Base +} + +@value interface Type3 { + refines Type2 +} + + +testcase "#self nested in param filter" { + compiles +} + +@value interface Base<#x> { + #x requires Writer<#self> + #x defines Equals<#self> +} + +@value interface Writer<#x|> { + write (#x) -> (#self) +} + +concrete Type { + refines Base + refines Writer + defines Equals +} + +define Type { + write (_) { + return self + } + + equals (_,_) { + return true + } +} + + +testcase "#self nested in inheritance" { + compiles +} + +concrete Type<#x> { + refines Gettable<#self> + defines Creator<#self> +} + +define Type { + get () { + return self + } + + create () { + return #self{ } + } +} + +@value interface Gettable<|#x> { + get () -> (#x) +} + +@type interface Creator<|#x> { + create () -> (#x) } diff --git a/tests/templates/templates.0rp b/tests/templates/templates.0rp --- a/tests/templates/templates.0rp +++ b/tests/templates/templates.0rp @@ -17,6 +17,10 @@ // Author: Kevin P. Barry [ta0kira@gmail.com] concrete Templated<#x> { - @type create () -> (Templated<#x>) + @category create<#y> + #y requires Formatted + #y defines Equals<#y> + () -> (Templated<#y>) + @value get () -> (#x) } diff --git a/tests/templates/tests.0rt b/tests/templates/tests.0rt --- a/tests/templates/tests.0rt +++ b/tests/templates/tests.0rt @@ -18,7 +18,7 @@ testcase "template compiles to binary" { crash - require "Templated\.create is not implemented" + require "Templated:create is not implemented" } unittest test { @@ -27,7 +27,7 @@ define Test { run () { - \ Templated.create() + \ Templated:create() } } diff --git a/tests/typename.0rt b/tests/typename.0rt --- a/tests/typename.0rt +++ b/tests/typename.0rt @@ -62,13 +62,6 @@ } } -unittest readPosition { - Formatted name <- typename>() - if (name.formatted() != "ReadPosition") { - fail(name) - } -} - unittest anyType { Formatted name <- typename() if (name.formatted() != "any") { diff --git a/zeolite-lang.cabal b/zeolite-lang.cabal --- a/zeolite-lang.cabal +++ b/zeolite-lang.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: zeolite-lang -version: 0.14.0.0 +version: 0.15.0.0 synopsis: Zeolite is a statically-typed, general-purpose programming language. description: @@ -80,28 +80,40 @@ example/parser/*.0rt, example/parser/*.0rx, example/parser/*.txt, - example/tree/README.md, - example/tree/*.0rp, - example/tree/*.0rt, - example/tree/*.0rx, + lib/container/README.md, + lib/container/.zeolite-module, + lib/container/*.0rp, + lib/container/*.0rt, + lib/container/*.0rx, + lib/container/src/*.cpp, + lib/file/README.md, lib/file/.zeolite-module, lib/file/*.0rp, lib/file/*.0rt, lib/file/*.0rx, - lib/file/*.cpp, + lib/file/src/*.cpp, + lib/math/README.md, lib/math/.zeolite-module, lib/math/*.0rp, lib/math/*.0rt, - lib/math/*.cpp, + lib/math/src/*.cpp, + lib/testing/README.md, lib/testing/.zeolite-module, lib/testing/*.0rp, lib/testing/*.0rt, lib/testing/*.0rx, + lib/thread/README.md, + lib/thread/.zeolite-module, + lib/thread/*.0rp, + lib/thread/*.0rt, + lib/thread/*.0rx, + lib/thread/src/*.cpp, + lib/util/README.md, lib/util/.zeolite-module, lib/util/*.0rp, lib/util/*.0rt, lib/util/*.0rx, - lib/util/*.cpp, + lib/util/src/*.cpp, tests/.zeolite-module, tests/*.0rp, tests/*.0rt,