diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,109 @@ # Revision history for zeolite-lang +## 0.18.0.0 -- 2021-08-01 + +### Compiler CLI + +* **[breaking]** Creates a single shared library per Zeolite module, and uses + dynamic linking as the default for binaries and `testcase`s. `--fast` mode + still uses static linking, and static linking can be enabled for a binary + using the `link_mode:` field in `.zeolite-module`: + + ```text + root: "../.." + path: "your/module" + private_deps: [ + "lib/util" + ] + mode: binary { + category: YourProgram + function: run + link_mode: static + } + ``` + +* **[breaking]** Eliminates dynamic memory allocation for `Bool`, `Char`, + `Float`, and `Int`, including `optional` and `weak` variants. This improves + the efficiency of code that makes a lot of function calls using those types. + + Note that when used as variable types, those types *already* avoided dynamic + allocation. This therefore only applies to passing them in function calls, and + using them with `optional` and `weak`. + + This breaks *all* existing C++ extensions: + + - `S` must be replaced with `BoxedValue`. + - Calls to `S_get` (only for `ValueType`) must be replaced with calls to the + `BoxedValue` constructor. + - `W` must be replaced with `WeakValue`. + - Calls to `W_get` must be replaced with calls to the `WeakValue` constructor. + - Calls to `->AsBool()`, `->AsChar()`, `->AsFloat()`, `->AsInt()`, + `->AsCharBuffer()`, and `->AsString()` must now use `.` instead of `->`. + - `Present`, `Require`, and `Strong` are now in `BoxedValue::` instead of in + `TypeValue::`. + + (Running `zeolite --templates` again will provide the correct type + signatures and local argument aliasing.) + +* **[breaking]** Updates `zeolite -c` (library mode) and `zeolite -m` (binary + mode) to generate a new `.zeolite-module` and exit. Previously, both modes + would create `.zeolite-module` and then attempt to compile it. The purpose of + this change is to make users more aware that `.zeolite-module` can/should be + edited, rather than attempting to generate a "correct" config entirely from + CLI flags. + +* **[new]** Updates recompile mode (`zeolite -r`) to reorder modules explicitly + specified in the command based on dependencies. For example, in the command + `zeolite -r foo bar`, if `foo` depends on `bar`, `bar` will be compiled first. + Previously, modules would be compiled in the order they were specified. + + Note that this *will not* account for *indirect* dependencies unless recursive + mode (`-R`) is used. This is because dealing with the intermediate dependency + would be ambiguous when not recompiling recursively. + +* **[behavior]** Even more optimization for function calls using 4 or fewer + arguments, returns, or function params. + +* **[behavior]** Updates the `fail` built-in to use `SIGTERM` instead of + `SIGABRT` to terminate the process, to prevent core dumps when `fail` is used + to signal an unhandled error. + +### Language + +* **[breaking]** Adds the `Bounded` `@type interface` for getting the + `minBound()` and `maxBound()` of a type, and implements it for `Int` and + `Char`. (This is breaking because `Bounded` is now reserved.) + +* **[breaking]** Makes `Char` unsigned when converting to `Int` using `asInt()`. + Previously, the value was signed, i.e., between -128 and 127. This change + makes the `Int` values line up better with hex and oct `Char` escapes. The + conversion from `Int` to `Char` (with `asChar()`) *is not* affected. + +* **[new]** Updates param inference (e.g., `call(foo)`) to handle param + filters containing multiple inferred params. Previously, if a function had a + filter such as `#x requires #y` and both `#x` and `#y` were inferred, + inference would fail because params were inferred one at a time. + +* **[new]** Adds the `timeout` field to `testcase`, to specify the number of + seconds to allow each `unittest` to run. The default is `30`, which should be + more than enough for most individual tests. The primary purpose of setting a + default is to prevent a deadlock or infinite loop from blocking continuous + integration (CI) runners. + +* **[new]** Updates parsing to allow calling functions on value intializers, and + `Bool`, `Char`, and `String` literals without needing `()`. For example, + `Type{ foo }.bar()`, `true.asInt()`, `'0'.asInt()`, `"abc".defaultOrder()`. + `Int` and `Float` literals still require `()`; otherwise, the use of `.` would + be ambiguous. + +### Libraries + +* **[new]** Adds `ParseChars` helper to `lib/util`, to parse `Float` and `Int` + from `String`s. + +* **[new]** Adds `monoSeconds()` to `Realtime` in `lib/util`, to get a + monotonic wall time in seconds. + ## 0.17.0.0 -- 2021-04-06 ### Language diff --git a/base/.zeolite-module b/base/.zeolite-module --- a/base/.zeolite-module +++ b/base/.zeolite-module @@ -25,6 +25,7 @@ source: "base/src/Extension_String.cpp" categories: [String] } + "base/boxed.hpp" "base/category-header.hpp" "base/category-source.hpp" "base/cycle-check.hpp" @@ -33,6 +34,7 @@ "base/thread-capture.h" "base/thread-crosser.h" "base/types.hpp" + "base/src/boxed.cpp" "base/src/category-source.cpp" "base/src/logging.cpp" "base/src/thread-crosser.cc" diff --git a/base/boxed.hpp b/base/boxed.hpp new file mode 100644 --- /dev/null +++ b/base/boxed.hpp @@ -0,0 +1,134 @@ +/* ----------------------------------------------------------------------------- +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] + +#ifndef BOXED_HPP_ +#define BOXED_HPP_ + +#include + +#include "function.hpp" +#include "types.hpp" + + +namespace zeolite_internal { + +struct UnionValue { + // NOTE: Using enum class would break the switch/case logic. + // NOTE: These enum values assume that dynamic allocation will never be + // aligned to an odd address within a few bytes of ULLONG_MAX. + enum Type : unsigned long long { + EMPTY = ~0x00ULL, + BOOL = ~0x02ULL, + CHAR = ~0x04ULL, + INT = ~0x06ULL, + FLOAT = ~0x08ULL, + }; + + struct Counters { + std::atomic_ullong strong_; + std::atomic_int weak_; + }; + + union { + Counters* counters_; + Type value_type_; + } type_; + + union { + TypeValue* as_pointer_; + bool as_bool_; + PrimChar as_char_; + PrimInt as_int_; + PrimFloat as_float_; + } value_; +}; + +} // namespace zeolite_internal + + +class BoxedValue { + public: + BoxedValue(); + + BoxedValue(const BoxedValue&); + BoxedValue& operator = (const BoxedValue&); + BoxedValue(BoxedValue&&); + BoxedValue& operator = (BoxedValue&&); + + BoxedValue(bool value); + BoxedValue(PrimChar value); + BoxedValue(PrimInt value); + BoxedValue(PrimFloat value); + BoxedValue(TypeValue* value); + + ~BoxedValue(); + + bool AsBool() const; + PrimChar AsChar() const; + PrimInt AsInt() const; + PrimFloat AsFloat() const; + + const PrimString& AsString() const; + PrimCharBuffer& AsCharBuffer() const; + + static bool Present(const BoxedValue& target); + static BoxedValue Require(const BoxedValue& target); + static BoxedValue Strong(const WeakValue& target); + + private: + friend class TypeValue; + friend class WeakValue; + + inline explicit BoxedValue(std::nullptr_t) : BoxedValue() {} + + explicit BoxedValue(const WeakValue& other); + + std::string CategoryName() const; + + ReturnTuple Dispatch(const BoxedValue& self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args) const; + + void Cleanup(); + + zeolite_internal::UnionValue union_; +}; + + +class WeakValue { + public: + WeakValue(); + + WeakValue(const WeakValue&); + WeakValue& operator = (const WeakValue&); + WeakValue(WeakValue&&); + WeakValue& operator = (WeakValue&&); + + WeakValue(const BoxedValue& other); + WeakValue& operator = (const BoxedValue& other); + + ~WeakValue(); + + private: + friend class BoxedValue; + + void Cleanup(); + + zeolite_internal::UnionValue union_; +}; + +#endif // BOXED_HPP_ diff --git a/base/builtin.0rp b/base/builtin.0rp --- a/base/builtin.0rp +++ b/base/builtin.0rp @@ -19,6 +19,10 @@ // Built-in boolean type. // // Literals are true and false. +// +// Notes: +// - You do not need () to make a function call on a literal; something like +// true.asInt() is totally fine. concrete Bool { refines AsBool refines AsInt @@ -29,13 +33,19 @@ defines Equals } -// Built-in character type. (ASCII only.) +// Built-in 8-bit character type. // // Literals: // - Printable: 'a', '0', etc. -// - Escapes: '\n', '\r', etc. ('\0' must be '\000', however) +// - Escapes: '\n', '\r', etc. ('\0' must be octal '\000', however) // - Hex: '\xAB' (always 2 digits) // - Oct: '\012' (always 3 digits) +// +// Notes: +// - You do not need () to make a function call on a literal; something like +// 'a'.asInt() is totally fine. +// - When converting to Int with asInt(), the value will always be unsigned, +// i.e., beween 0-255. ASCII characters will be in the 0-127 range. concrete Char { refines AsBool refines AsChar @@ -43,6 +53,7 @@ refines AsFloat refines Formatted + defines Bounded defines Default defines Equals defines LessThan @@ -53,6 +64,9 @@ // Literals: // - . required, with at least one digit on either side, e.g., 0.1 // - Scientific notation: 0.1E-10, etc. +// +// Notes: +// - You must use () to make a function call on a literal, e.g, (1.1).asInt(). concrete Float { refines AsBool refines AsInt @@ -76,6 +90,11 @@ // - 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. +// +// Notes: +// - You must use () to make a function call on a literal, e.g, (100).asFloat(). +// - When converting to Char with asChar(), the value will always be treated as +// unsigned, i.e., beween 0-255 mod 256. concrete Int { refines AsBool refines AsChar @@ -83,6 +102,7 @@ refines AsFloat refines Formatted + defines Bounded defines Default defines Equals defines LessThan @@ -91,6 +111,10 @@ // Built-in string of characters. (ASCII only.) // // Literals: Quote Char sequence with ". +// +// Notes: +// - You do not need () to make a function call on a literal; something like +// "abc".defaultOrder() is totally fine. concrete String { refines AsBool refines DefaultOrder @@ -258,6 +282,18 @@ @type interface Default { // Return a new copy of the default value. default () -> (#self) +} + +// The type has both min and max bounds. +// +// Notes: +// - The implementation should return either an immutable object or a new object +// for every call, so that mutations are localized. +@type interface Bounded { + // The min bound of the type. + minBound () -> (#self) + // The max bound of the type. + maxBound () -> (#self) } // The type can compare values for equality. diff --git a/base/category-header.hpp b/base/category-header.hpp --- a/base/category-header.hpp +++ b/base/category-header.hpp @@ -26,7 +26,6 @@ class TypeCategory; class TypeInstance; -class TypeValue; class CategoryFunction; class TypeFunction; class ValueFunction; diff --git a/base/category-source.hpp b/base/category-source.hpp --- a/base/category-source.hpp +++ b/base/category-source.hpp @@ -24,13 +24,15 @@ #include #include +#include "boxed.hpp" +#include "cycle-check.hpp" #include "types.hpp" #include "function.hpp" #define BUILTIN_FAIL(e) { \ FAIL() << TypeValue::Call((e), Function_Formatted_formatted, \ - ParamTuple(), ArgTuple()).Only()->AsString(); \ + ParamTuple(), ArgTuple()).Only().AsString(); \ __builtin_unreachable(); \ } @@ -39,13 +41,11 @@ __builtin_unreachable(); \ } -extern const S& Var_empty; - -S Box_Bool(bool value); -S Box_String(const PrimString& value); -S Box_Char(PrimChar value); -S Box_Int(PrimInt value); -S Box_Float(PrimFloat value); +BoxedValue Box_Bool(bool value); +BoxedValue Box_String(const PrimString& value); +BoxedValue Box_Char(PrimChar value); +BoxedValue Box_Int(PrimInt value); +BoxedValue Box_Float(PrimFloat value); S Merge_Intersect(L> params); S Merge_Union(L> params); @@ -53,14 +53,14 @@ const S& GetMerged_Any(); const S& GetMerged_All(); -extern const S& Var_empty; +extern const BoxedValue Var_empty; class TypeCategory { public: inline ReturnTuple Call(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) { - return FAIL_WHEN_NULL(Dispatch(label, params, FAIL_WHEN_NULL(args))); + return Dispatch(label, params, args); } virtual std::string CategoryName() const = 0; @@ -83,7 +83,7 @@ if (target == nullptr) { FAIL() << "Function called on null value"; } - return FAIL_WHEN_NULL(target->Dispatch(target, label, params, FAIL_WHEN_NULL(args))); + return target->Dispatch(target, label, params, args); } virtual std::string CategoryName() const = 0; @@ -97,8 +97,8 @@ return output.str(); } - static S Reduce(const S& from, - const S& to, S target) { + static BoxedValue Reduce(const S& from, + const S& to, BoxedValue target) { TRACE_FUNCTION("reduce") return CanConvert(from, to)? target : Var_empty; } @@ -156,38 +156,24 @@ class TypeValue { public: - inline static ReturnTuple Call(const S& target, - const ValueFunction& label, - const ParamTuple& params, const ValueTuple& args) { - if (target == nullptr) { - FAIL() << "Function called on null value"; - } - return FAIL_WHEN_NULL(target->Dispatch(target, label, params, FAIL_WHEN_NULL(args))); - } - - static bool Present(S target); - static S Require(S target); - static S Strong(W target); + static ReturnTuple Call(const BoxedValue& target, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args); - virtual bool AsBool() const; virtual const PrimString& AsString() const; - virtual PrimChar AsChar() const; virtual PrimCharBuffer& AsCharBuffer(); - virtual PrimInt AsInt() const; - virtual PrimFloat AsFloat() const; ALWAYS_PERMANENT(TypeValue) virtual ~TypeValue() = default; protected: + friend class BoxedValue; + TypeValue() = default; // NOTE: For some reason, making this private causes a segfault. virtual std::string CategoryName() const = 0; - virtual bool Present() const; - - virtual ReturnTuple Dispatch(const S& self, const ValueFunction& label, + virtual ReturnTuple Dispatch(const BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args); }; @@ -195,12 +181,12 @@ protected: // Passing in the function labels allows linking without depending on Order // when this class isn't used anywhere. - AnonymousOrder(const S cont, + AnonymousOrder(const BoxedValue cont, const ValueFunction& func_next, const ValueFunction& func_get); std::string CategoryName() const final; - ReturnTuple Dispatch(const S& self, + ReturnTuple Dispatch(const BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) final; @@ -208,12 +194,36 @@ virtual ~AnonymousOrder() = default; private: - virtual S Call_next(const S& self) = 0; - virtual S Call_get(const S& self) = 0; + virtual BoxedValue Call_next(const BoxedValue& self) = 0; + virtual BoxedValue Call_get(const BoxedValue& self) = 0; - const S container; + const BoxedValue container; const ValueFunction& function_next; const ValueFunction& function_get; +}; + +template +class InstanceCache { + public: + using Creator = std::function(typename Params

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

::Type params) { + while (lock_.test_and_set(std::memory_order_acquire)); + auto& cached = cache_[GetKeyFromParams

(params)]; + S type = cached; + if (!type) { + cached = type = create_(params); + } + lock_.clear(std::memory_order_release); + return type; + } + + private: + const Creator create_; + std::atomic_flag lock_ = ATOMIC_FLAG_INIT; + std::map::Type, S> cache_; }; #endif // CATEGORY_SOURCE_HPP_ diff --git a/base/function.hpp b/base/function.hpp --- a/base/function.hpp +++ b/base/function.hpp @@ -21,6 +21,8 @@ #include +#include "types.hpp" + struct CategoryFunction { const int param_count; diff --git a/base/internal.hpp b/base/internal.hpp --- a/base/internal.hpp +++ b/base/internal.hpp @@ -23,34 +23,9 @@ #include #include "category-source.hpp" -#include "cycle-check.hpp" #define COLLECTION_ID(vp) (int) 1000000009 * (long) (vp) - -template -class InstanceCache { - public: - using Creator = std::function(typename Params

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

::Type params) { - while (lock_.test_and_set(std::memory_order_acquire)); - auto& cached = cache_[GetKeyFromParams

(params)]; - S type = cached; - if (!type) { - cached = type = create_(params); - } - lock_.clear(std::memory_order_release); - return type; - } - - private: - const Creator create_; - std::atomic_flag lock_ = ATOMIC_FLAG_INIT; - std::map::Type, S> cache_; -}; template struct DispatchTable { diff --git a/base/logging.hpp b/base/logging.hpp --- a/base/logging.hpp +++ b/base/logging.hpp @@ -87,9 +87,6 @@ #define TRACE_CREATION \ TraceCreation trace_creation(creation_context_); - #define FAIL_WHEN_NULL(value) \ - FailWhenNull(value) - #else #define TRACE_FUNCTION(name) @@ -103,8 +100,6 @@ #define CAPTURE_CREATION #define TRACE_CREATION - - #define FAIL_WHEN_NULL(value) value #endif diff --git a/base/pooled.hpp b/base/pooled.hpp --- a/base/pooled.hpp +++ b/base/pooled.hpp @@ -20,9 +20,17 @@ #define POOLED_HPP_ +class ArgTuple; +class ReturnTuple; +class ParamTuple; + +namespace zeolite_internal { + template class PoolStorage { public: + using Managed = T; + inline T* data() const { return (T*) (this + 1); } @@ -48,9 +56,9 @@ template class PoolArray { - friend class ArgTuple; - friend class ReturnTuple; - friend class ParamTuple; + friend class ::ArgTuple; + friend class ::ReturnTuple; + friend class ::ParamTuple; constexpr PoolArray() : array_(nullptr) {} @@ -82,7 +90,7 @@ template inline void Init(Ts... data) { - if (sizeof...(Ts) > array_->size) { + if (sizeof...(Ts) > (array_? array_->size : 0)) { FAIL() << "Too many init values " << sizeof...(Ts); } InitRec(0, std::move(data)...); @@ -105,5 +113,7 @@ PoolStorage* array_; }; + +} // namespace zeolite_internal #endif // POOLED_HPP_ diff --git a/base/src/Extension_Bool.cpp b/base/src/Extension_Bool.cpp --- a/base/src/Extension_Bool.cpp +++ b/base/src/Extension_Bool.cpp @@ -46,42 +46,33 @@ ReturnTuple Call_equals(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Bool.equals") - const bool Var_arg1 = (args.At(0))->AsBool(); - const bool Var_arg2 = (args.At(1))->AsBool(); + const bool Var_arg1 = (args.At(0)).AsBool(); + const bool Var_arg2 = (args.At(1)).AsBool(); return ReturnTuple(Box_Bool(Var_arg1==Var_arg2)); } }; -struct ExtValue_Bool : public Value_Bool { - inline ExtValue_Bool(S p, bool value) : Value_Bool(p), value_(value) {} - - ReturnTuple Call_asBool(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { +ReturnTuple DispatchBool(bool value, const BoxedValue& Var_self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args) { + if (&label == &Function_AsBool_asBool) { TRACE_FUNCTION("Bool.asBool") return ReturnTuple(Var_self); } - - ReturnTuple Call_asFloat(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsFloat_asFloat) { TRACE_FUNCTION("Bool.asFloat") - return ReturnTuple(Box_Float(value_ ? 1.0 : 0.0)); + return ReturnTuple(Box_Float(value ? 1.0 : 0.0)); } - - ReturnTuple Call_asInt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsInt_asInt) { TRACE_FUNCTION("Bool.asInt") - return ReturnTuple(Box_Int(value_? 1 : 0)); + return ReturnTuple(Box_Int(value? 1 : 0)); } - - ReturnTuple Call_formatted(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_Formatted_formatted) { TRACE_FUNCTION("Bool.formatted") - return ReturnTuple(Box_String(value_? "true" : "false")); + return ReturnTuple(Box_String(value? "true" : "false")); } - - bool AsBool() const final { return value_; } - - const bool value_; -}; - -const S& Var_true = *new S(new ExtValue_Bool(CreateType_Bool(Params<0>::Type()), true)); -const S& Var_false = *new S(new ExtValue_Bool(CreateType_Bool(Params<0>::Type()), false)); + FAIL() << "Bool does not implement " << label; + __builtin_unreachable(); +} Category_Bool& CreateCategory_Bool() { static auto& category = *new ExtCategory_Bool(); @@ -97,6 +88,6 @@ using namespace ZEOLITE_PUBLIC_NAMESPACE; #endif // ZEOLITE_PUBLIC_NAMESPACE -S Box_Bool(bool value) { - return value? Var_true : Var_false; +BoxedValue Box_Bool(bool value) { + return BoxedValue(value); } diff --git a/base/src/Extension_Char.cpp b/base/src/Extension_Char.cpp --- a/base/src/Extension_Char.cpp +++ b/base/src/Extension_Char.cpp @@ -42,6 +42,16 @@ struct ExtType_Char : public Type_Char { inline ExtType_Char(Category_Char& p, Params<0>::Type params) : Type_Char(p, params) {} + ReturnTuple Call_maxBound(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Char.maxBound") + return ReturnTuple(Box_Char('\xff')); + } + + ReturnTuple Call_minBound(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Char.minBound") + return ReturnTuple(Box_Char('\0')); + } + ReturnTuple Call_default(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Char.default") return ReturnTuple(Box_Char('\0')); @@ -49,51 +59,44 @@ ReturnTuple Call_equals(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Char.equals") - const PrimChar Var_arg1 = (args.At(0))->AsChar(); - const PrimChar Var_arg2 = (args.At(1))->AsChar(); + const PrimChar Var_arg1 = (args.At(0)).AsChar(); + const PrimChar Var_arg2 = (args.At(1)).AsChar(); return ReturnTuple(Box_Bool(Var_arg1==Var_arg2)); } ReturnTuple Call_lessThan(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Char.lessThan") - const PrimChar Var_arg1 = (args.At(0))->AsChar(); - const PrimChar Var_arg2 = (args.At(1))->AsChar(); + const PrimChar Var_arg1 = (args.At(0)).AsChar(); + const PrimChar Var_arg2 = (args.At(1)).AsChar(); return ReturnTuple(Box_Bool(Var_arg1 p, PrimChar value) : Value_Char(p), value_(value) {} - - ReturnTuple Call_asBool(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { +ReturnTuple DispatchChar(PrimChar value, const BoxedValue& Var_self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args) { + if (&label == &Function_AsBool_asBool) { TRACE_FUNCTION("Char.asBool") - return ReturnTuple(Box_Bool(value_ != '\0')); + return ReturnTuple(Box_Bool(value != '\0')); } - - ReturnTuple Call_asChar(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsChar_asChar) { TRACE_FUNCTION("Char.asChar") return ReturnTuple(Var_self); } - - ReturnTuple Call_asFloat(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsFloat_asFloat) { TRACE_FUNCTION("Char.asFloat") - return ReturnTuple(Box_Float(value_)); + return ReturnTuple(Box_Float(((int) value + 256) % 256)); } - - ReturnTuple Call_asInt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsInt_asInt) { TRACE_FUNCTION("Char.asInt") - return ReturnTuple(Box_Int(value_)); + return ReturnTuple(Box_Int(((int) value + 256) % 256)); } - - ReturnTuple Call_formatted(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_Formatted_formatted) { TRACE_FUNCTION("Char.formatted") - return ReturnTuple(Box_String(PrimString(1,value_))); + return ReturnTuple(Box_String(PrimString(1,value))); } - - PrimChar AsChar() const final { return value_; } - - const PrimChar value_; -}; + FAIL() << "Char does not implement " << label; + __builtin_unreachable(); +} Category_Char& CreateCategory_Char() { static auto& category = *new ExtCategory_Char(); @@ -109,6 +112,6 @@ using namespace ZEOLITE_PUBLIC_NAMESPACE; #endif // ZEOLITE_PUBLIC_NAMESPACE -S Box_Char(PrimChar value) { - return S_get(new ExtValue_Char(CreateType_Char(Params<0>::Type()), value)); +BoxedValue Box_Char(PrimChar value) { + return BoxedValue(value); } diff --git a/base/src/Extension_CharBuffer.cpp b/base/src/Extension_CharBuffer.cpp --- a/base/src/Extension_CharBuffer.cpp +++ b/base/src/Extension_CharBuffer.cpp @@ -29,7 +29,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_CharBuffer(S parent, PrimCharBuffer buffer); +BoxedValue CreateValue_CharBuffer(S parent, PrimCharBuffer buffer); struct ExtCategory_CharBuffer : public Category_CharBuffer { }; @@ -39,7 +39,7 @@ ReturnTuple Call_new(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("CharBuffer.new") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); if (Var_arg1 < 0) { FAIL() << "Buffer size " << Var_arg1 << " is invalid"; } @@ -50,18 +50,18 @@ struct ExtValue_CharBuffer : public Value_CharBuffer { inline ExtValue_CharBuffer(S p, PrimCharBuffer value) : Value_CharBuffer(p), value_(std::move(value)) {} - ReturnTuple Call_readAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_readAt(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("CharBuffer.readAt") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); if (Var_arg1 < 0 || Var_arg1 >= AsCharBuffer().size()) { FAIL() << "Read position " << Var_arg1 << " is out of bounds"; } return ReturnTuple(Box_Char(AsCharBuffer()[Var_arg1])); } - ReturnTuple Call_resize(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_resize(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("CharBuffer.resize") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); if (Var_arg1 < 0) { FAIL() << "Buffer size " << Var_arg1 << " is invalid"; } else { @@ -70,15 +70,15 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_size(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_size(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("CharBuffer.size") return ReturnTuple(Box_Int(value_.size())); } - ReturnTuple Call_writeAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_writeAt(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("CharBuffer.writeAt") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - const PrimChar Var_arg2 = (args.At(1))->AsChar(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); + const PrimChar Var_arg2 = (args.At(1)).AsChar(); if (Var_arg1 < 0 || Var_arg1 >= value_.size()) { FAIL() << "Write position " << Var_arg1 << " is out of bounds"; } else { @@ -100,8 +100,8 @@ static const auto cached = S_get(new ExtType_CharBuffer(CreateCategory_CharBuffer(), Params<0>::Type())); return cached; } -S CreateValue_CharBuffer(S parent, PrimCharBuffer value) { - return S_get(new ExtValue_CharBuffer(parent, std::move(value))); +BoxedValue CreateValue_CharBuffer(S parent, PrimCharBuffer value) { + return BoxedValue(new ExtValue_CharBuffer(parent, std::move(value))); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/base/src/Extension_Float.cpp b/base/src/Extension_Float.cpp --- a/base/src/Extension_Float.cpp +++ b/base/src/Extension_Float.cpp @@ -49,48 +49,42 @@ ReturnTuple Call_equals(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Float.equals") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - const PrimFloat Var_arg2 = (args.At(1))->AsFloat(); + const PrimFloat Var_arg1 = (args.At(0)).AsFloat(); + const PrimFloat Var_arg2 = (args.At(1)).AsFloat(); return ReturnTuple(Box_Bool(Var_arg1==Var_arg2)); } ReturnTuple Call_lessThan(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Float.lessThan") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); - const PrimFloat Var_arg2 = (args.At(1))->AsFloat(); + const PrimFloat Var_arg1 = (args.At(0)).AsFloat(); + const PrimFloat Var_arg2 = (args.At(1)).AsFloat(); return ReturnTuple(Box_Bool(Var_arg1 p, PrimFloat value) : Value_Float(p), value_(value) {} - - ReturnTuple Call_asBool(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { +ReturnTuple DispatchFloat(PrimFloat value, const BoxedValue& Var_self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args) { + if (&label == &Function_AsBool_asBool) { TRACE_FUNCTION("Float.asBool") - return ReturnTuple(Box_Bool(value_ != 0.0)); + return ReturnTuple(Box_Bool(value != 0.0)); } - - ReturnTuple Call_asFloat(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsFloat_asFloat) { TRACE_FUNCTION("Float.asFloat") return ReturnTuple(Var_self); } - - ReturnTuple Call_asInt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsInt_asInt) { TRACE_FUNCTION("Float.asInt") - return ReturnTuple(Box_Int(value_)); + return ReturnTuple(Box_Int(value)); } - - ReturnTuple Call_formatted(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_Formatted_formatted) { TRACE_FUNCTION("Float.formatted") std::ostringstream output; - output << value_; + output << value; return ReturnTuple(Box_String(output.str())); } - - PrimFloat AsFloat() const final { return value_; } - - const PrimFloat value_; -}; + FAIL() << "Float does not implement " << label; + __builtin_unreachable(); +} Category_Float& CreateCategory_Float() { static auto& category = *new ExtCategory_Float(); @@ -106,6 +100,6 @@ using namespace ZEOLITE_PUBLIC_NAMESPACE; #endif // ZEOLITE_PUBLIC_NAMESPACE -S Box_Float(PrimFloat value) { - return S_get(new ExtValue_Float(CreateType_Float(Params<0>::Type()), value)); +BoxedValue Box_Float(PrimFloat value) { + return BoxedValue(value); } diff --git a/base/src/Extension_Int.cpp b/base/src/Extension_Int.cpp --- a/base/src/Extension_Int.cpp +++ b/base/src/Extension_Int.cpp @@ -16,6 +16,7 @@ // Author: Kevin P. Barry [ta0kira@gmail.com] +#include #include #include "category-source.hpp" @@ -44,6 +45,16 @@ struct ExtType_Int : public Type_Int { inline ExtType_Int(Category_Int& p, Params<0>::Type params) : Type_Int(p, params) {} + ReturnTuple Call_maxBound(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Int.maxBound") + return ReturnTuple(Box_Int(9223372036854775807LL)); + } + + ReturnTuple Call_minBound(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Int.minBound") + return ReturnTuple(Box_Int(-9223372036854775807LL - 1LL)); + } + ReturnTuple Call_default(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Int.default") return ReturnTuple(Box_Int(0)); @@ -51,53 +62,46 @@ ReturnTuple Call_equals(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Int.equals") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - const PrimInt Var_arg2 = (args.At(1))->AsInt(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); + const PrimInt Var_arg2 = (args.At(1)).AsInt(); return ReturnTuple(Box_Bool(Var_arg1==Var_arg2)); } ReturnTuple Call_lessThan(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Int.lessThan") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - const PrimInt Var_arg2 = (args.At(1))->AsInt(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); + const PrimInt Var_arg2 = (args.At(1)).AsInt(); return ReturnTuple(Box_Bool(Var_arg1 p, PrimInt value) : Value_Int(p), value_(value) {} - - ReturnTuple Call_asBool(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { +ReturnTuple DispatchInt(PrimInt value, const BoxedValue& Var_self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args) { + if (&label == &Function_AsBool_asBool) { TRACE_FUNCTION("Int.asBool") - return ReturnTuple(Box_Bool(value_ != 0)); + return ReturnTuple(Box_Bool(value != 0)); } - - ReturnTuple Call_asChar(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsChar_asChar) { TRACE_FUNCTION("Int.asChar") - return ReturnTuple(Box_Char(value_ % 0xff)); + return ReturnTuple(Box_Char(PrimChar(((value % 256) + 256) % 256))); } - - ReturnTuple Call_asFloat(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsFloat_asFloat) { TRACE_FUNCTION("Int.asFloat") - return ReturnTuple(Box_Float(value_)); + return ReturnTuple(Box_Float(value)); } - - ReturnTuple Call_asInt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_AsInt_asInt) { TRACE_FUNCTION("Int.asInt") return ReturnTuple(Var_self); } - - ReturnTuple Call_formatted(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + if (&label == &Function_Formatted_formatted) { TRACE_FUNCTION("Int.formatted") std::ostringstream output; - output << value_; + output << value; return ReturnTuple(Box_String(output.str())); } - - PrimInt AsInt() const final { return value_; } - - const PrimInt value_; -}; + FAIL() << "Int does not implement " << label; + __builtin_unreachable(); +} Category_Int& CreateCategory_Int() { static auto& category = *new ExtCategory_Int(); @@ -113,6 +117,6 @@ using namespace ZEOLITE_PUBLIC_NAMESPACE; #endif // ZEOLITE_PUBLIC_NAMESPACE -S Box_Int(PrimInt value) { - return S_get(new ExtValue_Int(CreateType_Int(Params<0>::Type()), value)); +BoxedValue Box_Int(PrimInt value) { + return BoxedValue(value); } diff --git a/base/src/Extension_String.cpp b/base/src/Extension_String.cpp --- a/base/src/Extension_String.cpp +++ b/base/src/Extension_String.cpp @@ -47,7 +47,7 @@ public: std::string CategoryName() const final { return "StringBuilder"; } - ReturnTuple Dispatch(const S& self, + ReturnTuple Dispatch(const BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) final { if (args.Size() != label.arg_count) { @@ -59,7 +59,7 @@ if (&label == &Function_Append_append) { TRACE_FUNCTION("StringBuilder.append") std::lock_guard lock(mutex); - output_ << args.At(0)->AsString(); + output_ << args.At(0).AsString(); return ReturnTuple(self); } if (&label == &Function_Build_build) { @@ -80,7 +80,7 @@ ReturnTuple Call_builder(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.builder") - return ReturnTuple(S(new Value_StringBuilder)); + return ReturnTuple(BoxedValue(new Value_StringBuilder)); } ReturnTuple Call_default(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { @@ -90,30 +90,30 @@ ReturnTuple Call_equals(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.equals") - const S& Var_arg1 = (args.At(0)); - const S& Var_arg2 = (args.At(1)); - return ReturnTuple(Box_Bool(Var_arg1->AsString()==Var_arg2->AsString())); + const BoxedValue& Var_arg1 = (args.At(0)); + const BoxedValue& Var_arg2 = (args.At(1)); + return ReturnTuple(Box_Bool(Var_arg1.AsString()==Var_arg2.AsString())); } ReturnTuple Call_fromCharBuffer(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.fromCharBuffer") - const S& Var_arg1 = (args.At(0)); - return ReturnTuple(Box_String(PrimString(Var_arg1->AsCharBuffer()))); + const BoxedValue& Var_arg1 = (args.At(0)); + return ReturnTuple(Box_String(PrimString(Var_arg1.AsCharBuffer()))); } ReturnTuple Call_lessThan(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.lessThan") - const S& Var_arg1 = (args.At(0)); - const S& Var_arg2 = (args.At(1)); - return ReturnTuple(Box_Bool(Var_arg1->AsString()AsString())); + const BoxedValue& Var_arg1 = (args.At(0)); + const BoxedValue& Var_arg2 = (args.At(1)); + return ReturnTuple(Box_Bool(Var_arg1.AsString() container, const std::string& s) + StringOrder(BoxedValue container, const std::string& s) : AnonymousOrder(container, Function_Order_next, Function_Order_get), value(s) {} - S Call_next(const S& self) final { + BoxedValue Call_next(const BoxedValue& self) final { if (index+1 >= value.size()) { return Var_empty; } else { @@ -122,7 +122,7 @@ } } - S Call_get(const S& self) final { + BoxedValue Call_get(const BoxedValue& self) final { if (index >= value.size()) FAIL() << "Iterated past end of String"; return Box_Char(value[index]); } @@ -134,43 +134,43 @@ struct ExtValue_String : public Value_String { inline ExtValue_String(S p, const PrimString& value) : Value_String(p), value_(value) {} - ReturnTuple Call_asBool(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_asBool(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.asBool") return ReturnTuple(Box_Bool(value_.size() != 0)); } - ReturnTuple Call_defaultOrder(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_defaultOrder(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.defaultOrder") if (value_.empty()) { return ReturnTuple(Var_empty); } else { - return ReturnTuple(S_get(new StringOrder(Var_self, value_))); + return ReturnTuple(BoxedValue(new StringOrder(Var_self, value_))); } } - ReturnTuple Call_formatted(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_formatted(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.formatted") return ReturnTuple(Var_self); } - ReturnTuple Call_readAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_readAt(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.readAt") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); + 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 Call_size(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_size(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.size") return ReturnTuple(Box_Int(value_.size())); } - ReturnTuple Call_subSequence(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_subSequence(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.subSequence") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - const PrimInt Var_arg2 = (args.At(1))->AsInt(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); + const PrimInt Var_arg2 = (args.At(1)).AsInt(); if (Var_arg1 < 0 || Var_arg1 > value_.size()) { FAIL() << "Subsequence position " << Var_arg1 << " is out of bounds"; } @@ -199,6 +199,6 @@ using namespace ZEOLITE_PUBLIC_NAMESPACE; #endif // ZEOLITE_PUBLIC_NAMESPACE -S Box_String(const PrimString& value) { - return S_get(new ExtValue_String(CreateType_String(Params<0>::Type()), value)); +BoxedValue Box_String(const PrimString& value) { + return BoxedValue(new ExtValue_String(CreateType_String(Params<0>::Type()), value)); } diff --git a/base/src/boxed.cpp b/base/src/boxed.cpp new file mode 100644 --- /dev/null +++ b/base/src/boxed.cpp @@ -0,0 +1,420 @@ +/* ----------------------------------------------------------------------------- +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 "boxed.hpp" + +#include + +#include "category-source.hpp" + + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +namespace ZEOLITE_PUBLIC_NAMESPACE { +#endif // ZEOLITE_PUBLIC_NAMESPACE + +ReturnTuple DispatchBool(bool value, const BoxedValue& Var_self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args); + +ReturnTuple DispatchChar(PrimChar value, const BoxedValue& Var_self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args); + +ReturnTuple DispatchInt(PrimInt value, const BoxedValue& Var_self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args); + +ReturnTuple DispatchFloat(PrimFloat value, const BoxedValue& Var_self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args); + +#ifdef ZEOLITE_PUBLIC_NAMESPACE +} // namespace ZEOLITE_PUBLIC_NAMESPACE +using namespace ZEOLITE_PUBLIC_NAMESPACE; +#endif // ZEOLITE_PUBLIC_NAMESPACE + + +using zeolite_internal::UnionValue; + + +BoxedValue::BoxedValue() + : union_{ { .value_type_ = UnionValue::Type::EMPTY }, + { .as_pointer_ = nullptr } } {} + +BoxedValue::BoxedValue(const BoxedValue& other) + : union_(other.union_) { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + ++union_.type_.counters_->strong_; + break; + } +} + +BoxedValue& BoxedValue::operator = (const BoxedValue& other) { + if (&other != this) { + Cleanup(); + union_ = other.union_; + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + ++union_.type_.counters_->strong_; + break; + } + } + return *this; +} + +BoxedValue::BoxedValue(BoxedValue&& other) + : union_(other.union_) { + other.union_.type_.value_type_ = UnionValue::Type::EMPTY; + other.union_.value_.as_pointer_ = nullptr; +} + +BoxedValue& BoxedValue::operator = (BoxedValue&& other) { + if (&other != this) { + Cleanup(); + union_ = other.union_; + other.union_.type_.value_type_ = UnionValue::Type::EMPTY; + other.union_.value_.as_pointer_ = nullptr; + } + return *this; +} + +BoxedValue::BoxedValue(const WeakValue& other) + : union_(other.union_) { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + // Using the top 24 bits here allows blocking the deletion of the pointer + // without risking other threads using a bad pointer. This assumes that + // each object will have fewer than 2^40 references, and that fewer than + // 2^24 threads will be attempting to lock a weak reference for a given + // object at any one time. + static constexpr unsigned long long strong_lock = 0x1ULL << 40; + if (union_.type_.counters_->strong_.fetch_add(strong_lock) % strong_lock == 0) { + // NOTE: Subtraction of strong_lock *cannot* be optimized out! + // + // Unsigned overflow would still leave strong_%strong_lock == 0, but + // there could be a race-condition between three threads: + // + // Thread 1: Enters *this* constructor while the pointer is still valid. + // Thread 2: Enters BoxedValue::Cleanup and removes the last reference. + // Thread 3: Enters *this* constructor before Thread 1 subtracts + // strong_lock-1, meaning strong_%strong_lock == 0. + // Thread 1: Subtracts strong_lock-1 (+1 overall) to revive the pointer. + // + // This still leaves all three threads in a valid state, but with Thread + // 3 getting empty instead of a still-valid pointer. In other words, + // strong_%strong_lock == 0 *doesn't* guarantee that the pointer is no + // longer valid. + union_.type_.counters_->strong_.fetch_sub(strong_lock); + union_.type_.value_type_ = UnionValue::Type::EMPTY; + union_.value_.as_pointer_ = nullptr; + } else { + union_.type_.counters_->strong_.fetch_sub(strong_lock-1); + } + break; + } +} + +BoxedValue::BoxedValue(bool value) + : union_{ { .value_type_ = UnionValue::Type::BOOL }, + { .as_bool_ = value } } {} + +BoxedValue::BoxedValue(PrimChar value) + : union_{ { .value_type_ = UnionValue::Type::CHAR }, + { .as_char_= value } } {} + +BoxedValue::BoxedValue(PrimInt value) + : union_{ { .value_type_ = UnionValue::Type::INT }, + { .as_int_= value } } {} + +BoxedValue::BoxedValue(PrimFloat value) + : union_{ { .value_type_ = UnionValue::Type::FLOAT }, + { .as_float_ = value } } {} + +BoxedValue::BoxedValue(TypeValue* value) + : union_{ { .counters_ = new UnionValue::Counters{{1},{1}} }, + { .as_pointer_ = value } } {} + +BoxedValue::~BoxedValue() { + Cleanup(); +} + +bool BoxedValue::AsBool() const { + if (union_.type_.value_type_ != UnionValue::Type::BOOL) { + FAIL() << CategoryName() << " is not a Bool value"; + } + return union_.value_.as_bool_; +} + +PrimChar BoxedValue::AsChar() const { + if (union_.type_.value_type_ != UnionValue::Type::CHAR) { + FAIL() << CategoryName() << " is not a Char value"; + } + return union_.value_.as_char_; +} + +PrimInt BoxedValue::AsInt() const { + if (union_.type_.value_type_ != UnionValue::Type::INT) { + FAIL() << CategoryName() << " is not an Int value"; + } + return union_.value_.as_int_; +} + +PrimFloat BoxedValue::AsFloat() const { + if (union_.type_.value_type_ != UnionValue::Type::FLOAT) { + FAIL() << CategoryName() << " is not a Float value"; + } + return union_.value_.as_float_; +} + +const PrimString& BoxedValue::AsString() const { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + FAIL() << CategoryName() << " is not a String value"; + __builtin_unreachable(); + break; + default: + if (!union_.value_.as_pointer_) { + FAIL() << "Function called on null pointer"; + } + return union_.value_.as_pointer_->AsString(); + } +} + +PrimCharBuffer& BoxedValue::AsCharBuffer() const { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + FAIL() << CategoryName() << " is not a CharBuffer value"; + __builtin_unreachable(); + break; + default: + if (!union_.value_.as_pointer_) { + FAIL() << "Function called on null pointer"; + } + return union_.value_.as_pointer_->AsCharBuffer(); + } +} + +// static +bool BoxedValue::Present(const BoxedValue& target) { + return target.union_.type_.value_type_ != UnionValue::Type::EMPTY; +} + +// static +BoxedValue BoxedValue::Require(const BoxedValue& target) { + if (target.union_.type_.value_type_ == UnionValue::Type::EMPTY) { + FAIL() << "Cannot require empty value"; + } + return target; +} + +// static +BoxedValue BoxedValue::Strong(const WeakValue& target) { + return BoxedValue(target); +} + +std::string BoxedValue::CategoryName() const { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: return "empty"; + case UnionValue::Type::BOOL: return "Bool"; + case UnionValue::Type::CHAR: return "Char"; + case UnionValue::Type::INT: return "Int"; + case UnionValue::Type::FLOAT: return "Float"; + default: + if (!union_.value_.as_pointer_) { + FAIL() << "Function called on null pointer"; + } + return union_.value_.as_pointer_->CategoryName(); + } +} + +ReturnTuple BoxedValue::Dispatch( + const BoxedValue& self, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args) const { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + FAIL() << "Function called on empty value"; + __builtin_unreachable(); + break; + case UnionValue::Type::BOOL: + return DispatchBool(union_.value_.as_bool_, self, label, params, args); + case UnionValue::Type::CHAR: + return DispatchChar(union_.value_.as_char_, self, label, params, args); + case UnionValue::Type::INT: + return DispatchInt(union_.value_.as_int_, self, label, params, args); + case UnionValue::Type::FLOAT: + return DispatchFloat(union_.value_.as_float_, self, label, params, args); + default: + if (!union_.value_.as_pointer_) { + FAIL() << "Function called on null pointer"; + } + return union_.value_.as_pointer_->Dispatch(self, label, params, args); + } +} + +void BoxedValue::Cleanup() { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + if (--union_.type_.counters_->strong_ == 0) { + delete union_.value_.as_pointer_; + if (--union_.type_.counters_->weak_ == 0) { + delete union_.type_.counters_; + } + } + break; + } + union_.type_.value_type_ = UnionValue::Type::EMPTY; + union_.value_.as_pointer_ = nullptr; +} + + +WeakValue::WeakValue() + : union_{ { .value_type_ = UnionValue::Type::EMPTY }, + { .as_pointer_ = nullptr } } {} + +WeakValue::WeakValue(const WeakValue& other) + : union_(other.union_) { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + ++union_.type_.counters_->weak_; + break; + } +} + +WeakValue& WeakValue::operator = (const WeakValue& other) { + if (&other != this) { + Cleanup(); + union_ = other.union_; + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + ++union_.type_.counters_->weak_; + break; + } + } + return *this; +} + +WeakValue::WeakValue(WeakValue&& other) + : union_(other.union_) { + other.union_.type_.value_type_ = UnionValue::Type::EMPTY; + other.union_.value_.as_pointer_ = nullptr; +} + +WeakValue& WeakValue::operator = (WeakValue&& other) { + if (&other != this) { + Cleanup(); + union_ = other.union_; + other.union_.type_.value_type_ = UnionValue::Type::EMPTY; + other.union_.value_.as_pointer_ = nullptr; + } + return *this; +} + +WeakValue::WeakValue(const BoxedValue& other) + : union_(other.union_) { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + ++union_.type_.counters_->weak_; + break; + } +} + +WeakValue& WeakValue::operator = (const BoxedValue& other) { + Cleanup(); + union_ = other.union_; + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + ++union_.type_.counters_->weak_; + break; + } + return *this; +} + +WeakValue::~WeakValue() { + Cleanup(); +} + +void WeakValue::Cleanup() { + switch (union_.type_.value_type_) { + case UnionValue::Type::EMPTY: + case UnionValue::Type::BOOL: + case UnionValue::Type::CHAR: + case UnionValue::Type::INT: + case UnionValue::Type::FLOAT: + break; + default: + if (--union_.type_.counters_->weak_ == 0) { + delete union_.type_.counters_; + } + break; + } + union_.type_.value_type_ = UnionValue::Type::EMPTY; + union_.value_.as_pointer_ = nullptr; +} diff --git a/base/src/category-source.cpp b/base/src/category-source.cpp --- a/base/src/category-source.cpp +++ b/base/src/category-source.cpp @@ -25,19 +25,6 @@ namespace { -struct OptionalEmpty : public TypeValue { - ReturnTuple Dispatch(const S& self, - const ValueFunction& label, - const ParamTuple& params, const ValueTuple& args) final { - FAIL() << "Function called on empty value"; - __builtin_unreachable(); - } - - std::string CategoryName() const final { return "empty"; } - - bool Present() const final { return false; } -}; - struct Type_Intersect : public TypeInstance { Type_Intersect(L> params) : params_(params.begin(), params.end()) {} @@ -134,8 +121,7 @@ return instance; } - -const S& Var_empty = *new S(new OptionalEmpty()); +const BoxedValue Var_empty; ReturnTuple TypeCategory::Dispatch(const CategoryFunction& label, @@ -150,7 +136,7 @@ __builtin_unreachable(); } -ReturnTuple TypeValue::Dispatch(const S& self, const ValueFunction& label, +ReturnTuple TypeValue::Dispatch(const BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) { FAIL() << CategoryName() << " does not implement " << label; __builtin_unreachable(); @@ -219,31 +205,10 @@ } } -bool TypeValue::Present(S target) { - if (target == nullptr) { - FAIL() << "Builtin called on null value"; - } - return target->Present(); -} - -S TypeValue::Require(S target) { - if (target == nullptr) { - FAIL() << "Builtin called on null value"; - } - if (!target->Present()) { - FAIL() << "Cannot require empty value"; - } - return target; -} - -S TypeValue::Strong(W target) { - const auto strong = target.lock(); - return strong? strong : Var_empty; -} - -bool TypeValue::AsBool() const { - FAIL() << CategoryName() << " is not a Bool value"; - __builtin_unreachable(); +// static +ReturnTuple TypeValue::Call(const BoxedValue& target, const ValueFunction& label, + const ParamTuple& params, const ValueTuple& args) { + return target.Dispatch(target, label, params, args); } const PrimString& TypeValue::AsString() const { @@ -251,31 +216,12 @@ __builtin_unreachable(); } -PrimChar TypeValue::AsChar() const { - FAIL() << CategoryName() << " is not a Char value"; - __builtin_unreachable(); -} - PrimCharBuffer& TypeValue::AsCharBuffer() { FAIL() << CategoryName() << " is not a CharBuffer value"; __builtin_unreachable(); } -PrimInt TypeValue::AsInt() const { - FAIL() << CategoryName() << " is not an Int value"; - __builtin_unreachable(); -} - -PrimFloat TypeValue::AsFloat() const { - FAIL() << CategoryName() << " is not a Float value"; - __builtin_unreachable(); -} - -bool TypeValue::Present() const { - return true; -} - -AnonymousOrder::AnonymousOrder(const S cont, +AnonymousOrder::AnonymousOrder(const BoxedValue cont, const ValueFunction& func_next, const ValueFunction& func_get) : container(cont), function_next(func_next), function_get(func_get) {} @@ -283,7 +229,7 @@ std::string AnonymousOrder::CategoryName() const { return "AnonymousOrder"; } ReturnTuple AnonymousOrder::Dispatch( - const S& self, const ValueFunction& label, + const BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) { if (&label == &function_next) { TRACE_FUNCTION("AnonymousOrder.next") diff --git a/base/src/logging.cpp b/base/src/logging.cpp --- a/base/src/logging.cpp +++ b/base/src/logging.cpp @@ -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. @@ -18,7 +18,6 @@ #include "logging.hpp" -#include #include #include #include @@ -26,7 +25,7 @@ LogThenCrash::LogThenCrash(bool fail, const std::string& condition) - : fail_(fail), signal_(SIGABRT), condition_(condition) {} + : fail_(fail), signal_(SIGTERM), condition_(condition) {} LogThenCrash::LogThenCrash(bool fail, int signal) : fail_(fail), signal_(signal) {} @@ -45,7 +44,7 @@ PrintTrace(TraceContext::GetTrace()); const TraceList creation_trace = TraceCreation::GetTrace(); if (!creation_trace.empty()) { - std::cerr << TraceCreation::GetType() << " value originally created at:" << std::endl; + std::cerr << "Original " << TraceCreation::GetType() << " value creation:" << std::endl; PrintTrace(creation_trace); } std::raise(signal_); diff --git a/base/src/types.cpp b/base/src/types.cpp --- a/base/src/types.cpp +++ b/base/src/types.cpp @@ -20,6 +20,7 @@ #include +#include "boxed.hpp" #include "logging.hpp" @@ -27,14 +28,14 @@ return size_; } -const S& ArgTuple::At(int pos) const { +const BoxedValue& ArgTuple::At(int pos) const { if (pos < 0 || pos >= size_) { FAIL() << "Bad ArgTuple index"; } return *data_[pos]; } -const S& ArgTuple::Only() const { +const BoxedValue& ArgTuple::Only() const { if (size_ != 1) { FAIL() << "Bad ArgTuple index"; } @@ -56,21 +57,21 @@ return size_; } -S& ReturnTuple::At(int pos) { +BoxedValue& ReturnTuple::At(int pos) { if (pos < 0 || pos >= size_) { FAIL() << "Bad ReturnTuple index"; } return data_[pos]; } -const S& ReturnTuple::At(int pos) const { +const BoxedValue& ReturnTuple::At(int pos) const { if (pos < 0 || pos >= size_) { FAIL() << "Bad ReturnTuple index"; } return data_[pos]; } -const S& ReturnTuple::Only() const { +const BoxedValue& ReturnTuple::Only() const { if (size_ != 1) { FAIL() << "Bad ReturnTuple index"; } @@ -89,149 +90,130 @@ } -template -class PoolCleanup { - public: - constexpr PoolCleanup() {} +namespace { - ~PoolCleanup() { - PoolManager::Purge(); +template +static inline P* PoolTakeCommon(std::atomic_flag& flag, + P*& pool, unsigned int& size) { + while (flag.test_and_set(std::memory_order_acquire)); + P* const storage = pool; + if (storage == nullptr) { + flag.clear(std::memory_order_release); + return nullptr; + } else { + --size; + pool = storage->next; + flag.clear(std::memory_order_release); + storage->next = nullptr; + new (storage->data()) typename P::Managed[storage->size]; + return storage; } +} - private: - PoolCleanup(const PoolCleanup&) = delete; - PoolCleanup operator = (const PoolCleanup&) = delete; - PoolCleanup(PoolCleanup&&) = delete; - PoolCleanup operator = (PoolCleanup&&) = delete; -}; +template +static inline bool PoolReturnCommon(P* storage, std::atomic_flag& flag, + P*& pool, unsigned int& size, + unsigned int limit) { + while (flag.test_and_set(std::memory_order_acquire)); + P* const head = pool; + if (size < limit) { + ++size; + storage->next = head; + pool = storage; + flag.clear(std::memory_order_release); + return true; + } else { + flag.clear(std::memory_order_release); + return false; + } +} +} // namespace -static void* const pool_busy_flag_ = (void*) ~0x00; +namespace zeolite_internal { -static unsigned int return_tuple_pool4_size_ = 0; -static std::atomic>*> return_tuple_pool4_{nullptr}; +unsigned int PoolManager::pool4_size_ = 0; +typename PoolManager::PoolEntry* PoolManager::pool4_{nullptr}; +std::atomic_flag PoolManager::pool4_flag_ = ATOMIC_FLAG_INIT; // static -PoolStorage>* PoolManager>::Take(int size) { +typename PoolManager::PoolEntry* PoolManager::Take(int size) { if (size == 0) return nullptr; if (size < 4) { size = 4; } - if (size == 4) { - PoolEntry* storage = nullptr; - while ((storage = return_tuple_pool4_.exchange((PoolEntry*) pool_busy_flag_)) == pool_busy_flag_); - if (storage == nullptr) { - return_tuple_pool4_.exchange(nullptr); - } else { - --return_tuple_pool4_size_; - return_tuple_pool4_.exchange(storage->next); - storage->next = nullptr; - new (storage->data()) Managed[storage->size]; - return storage; - } + PoolEntry* storage = nullptr; + if (size == 4 && (storage = PoolTakeCommon(pool4_flag_, pool4_, pool4_size_))) { + return storage; } - PoolEntry* const storage = new (new unsigned char[sizeof(PoolEntry) + size*sizeof(Managed)]) PoolEntry(size, nullptr); + storage = new (new unsigned char[sizeof(PoolEntry) + size*sizeof(Managed)]) PoolEntry(size, nullptr); new (storage->data()) Managed[size]; return storage; } // static -void PoolManager>::Return(PoolEntry* storage) { +void PoolManager::Return(PoolEntry* storage) { if (!storage) return; for (int i = 0; i < storage->size; ++i) { storage->data()[i].~Managed(); } - if (storage->size == 4) { - PoolEntry* head = nullptr; - while ((head = return_tuple_pool4_.exchange((PoolEntry*) pool_busy_flag_)) == pool_busy_flag_); - if (return_tuple_pool4_size_ < pool_limit_) { - ++return_tuple_pool4_size_; - storage->next = head; - return_tuple_pool4_.exchange(storage); - return; - } else { - return_tuple_pool4_.exchange(head); - } + if (storage->size == 4 && PoolReturnCommon(storage, pool4_flag_, pool4_, pool4_size_, pool_limit_)) { + return; } storage->~PoolEntry(); delete[] (unsigned char*) storage; } -static unsigned int arg_tuple_pool4_size_ = 0; -static std::atomic*>*> arg_tuple_pool4_{nullptr}; +unsigned int PoolManager::pool4_size_ = 0; +typename PoolManager::PoolEntry* PoolManager::pool4_{nullptr}; +std::atomic_flag PoolManager::pool4_flag_ = ATOMIC_FLAG_INIT; // static -PoolStorage*>* PoolManager*>::Take(int size) { +typename PoolManager::PoolEntry* PoolManager::Take(int size) { if (size == 0) return nullptr; if (size < 4) { size = 4; } - if (size == 4) { - PoolEntry* storage = nullptr; - while ((storage = arg_tuple_pool4_.exchange((PoolEntry*) pool_busy_flag_)) == pool_busy_flag_); - if (storage == nullptr) { - arg_tuple_pool4_.exchange(nullptr); - } else { - --arg_tuple_pool4_size_; - arg_tuple_pool4_.exchange(storage->next); - storage->next = nullptr; - new (storage->data()) Managed[storage->size]; - return storage; - } + PoolEntry* storage = nullptr; + if (size == 4 && (storage = PoolTakeCommon(pool4_flag_, pool4_, pool4_size_))) { + return storage; } - PoolEntry* const storage = new (new unsigned char[sizeof(PoolEntry) + size*sizeof(Managed)]) PoolEntry(size, nullptr); + storage = new (new unsigned char[sizeof(PoolEntry) + size*sizeof(Managed)]) PoolEntry(size, nullptr); new (storage->data()) Managed[size]; return storage; } // static -void PoolManager*>::Return(PoolEntry* storage) { +void PoolManager::Return(PoolEntry* storage) { if (!storage) return; for (int i = 0; i < storage->size; ++i) { storage->data()[i].~Managed(); } - if (storage->size == 4) { - PoolEntry* head = nullptr; - while ((head = arg_tuple_pool4_.exchange((PoolEntry*) pool_busy_flag_)) == pool_busy_flag_); - if (arg_tuple_pool4_size_ < pool_limit_) { - ++arg_tuple_pool4_size_; - storage->next = head; - arg_tuple_pool4_.exchange(storage); - return; - } else { - arg_tuple_pool4_.exchange(head); - } + if (storage->size == 4 && PoolReturnCommon(storage, pool4_flag_, pool4_, pool4_size_, pool_limit_)) { + return; } storage->~PoolEntry(); delete[] (unsigned char*) storage; } -static unsigned int param_tuple_pool4_size_ = 0; -static std::atomic>*> param_tuple_pool4_{nullptr}; +unsigned int PoolManager>::pool4_size_ = 0; +typename PoolManager>::PoolEntry* PoolManager>::pool4_{nullptr}; +std::atomic_flag PoolManager>::pool4_flag_ = ATOMIC_FLAG_INIT; // static -PoolStorage>* PoolManager>::Take(int size) { +typename PoolManager>::PoolEntry* PoolManager>::Take(int size) { if (size == 0) return nullptr; if (size < 4) { size = 4; } - if (size == 4) { - PoolEntry* storage = nullptr; - while ((storage = param_tuple_pool4_.exchange((PoolEntry*) pool_busy_flag_)) == pool_busy_flag_); - if (storage == nullptr) { - param_tuple_pool4_.exchange(nullptr); - } else { - --param_tuple_pool4_size_; - param_tuple_pool4_.exchange(storage->next); - storage->next = nullptr; - new (storage->data()) Managed[storage->size]; - return storage; - } + PoolEntry* storage = nullptr; + if (size == 4 && (storage = PoolTakeCommon(pool4_flag_, pool4_, pool4_size_))) { + return storage; } - PoolEntry* const storage = new (new unsigned char[sizeof(PoolEntry) + size*sizeof(Managed)]) PoolEntry(size, nullptr); + storage = new (new unsigned char[sizeof(PoolEntry) + size*sizeof(Managed)]) PoolEntry(size, nullptr); new (storage->data()) Managed[size]; return storage; } @@ -242,18 +224,11 @@ for (int i = 0; i < storage->size; ++i) { storage->data()[i].~Managed(); } - if (storage->size == 4) { - PoolEntry* head = nullptr; - while ((head = param_tuple_pool4_.exchange((PoolEntry*) pool_busy_flag_)) == pool_busy_flag_); - if (param_tuple_pool4_size_ < pool_limit_) { - ++param_tuple_pool4_size_; - storage->next = head; - param_tuple_pool4_.exchange(storage); - return; - } else { - param_tuple_pool4_.exchange(head); - } + if (storage->size == 4 && PoolReturnCommon(storage, pool4_flag_, pool4_, pool4_size_, pool_limit_)) { + return; } storage->~PoolEntry(); delete[] (unsigned char*) storage; } + +} // namespace zeolite_internal diff --git a/base/types.hpp b/base/types.hpp --- a/base/types.hpp +++ b/base/types.hpp @@ -19,6 +19,7 @@ #ifndef TYPES_HPP_ #define TYPES_HPP_ +#include #include #include #include @@ -60,12 +61,6 @@ template inline S S_get(T* val) { return S(val); } -template -using W = std::weak_ptr; - -template -inline W W_get(T* val) { return W(val); } - template using T = std::tuple; @@ -122,6 +117,8 @@ class TypeCategory; class TypeInstance; class TypeValue; +class BoxedValue; +class WeakValue; template struct Params { @@ -165,8 +162,8 @@ class ValueTuple { public: virtual int Size() const = 0; - virtual const S& At(int pos) const = 0; - virtual const S& Only() const = 0; + virtual const BoxedValue& At(int pos) const = 0; + virtual const BoxedValue& Only() const = 0; protected: ValueTuple() = default; @@ -176,10 +173,13 @@ void* operator new(std::size_t size) = delete; }; + +namespace zeolite_internal { + template<> -class PoolManager> { - using Managed = S; - using PoolEntry = PoolStorage; +class PoolManager { + using PoolEntry = PoolStorage; + using Managed = PoolEntry::Managed; template friend class PoolArray; @@ -187,8 +187,46 @@ static void Return(PoolEntry* storage); static constexpr unsigned int pool_limit_ = 256; + static unsigned int pool4_size_; + static PoolEntry* pool4_; + static std::atomic_flag pool4_flag_; }; +template<> +class PoolManager { + using PoolEntry = PoolStorage; + using Managed = PoolEntry::Managed; + + template friend class PoolArray; + + static PoolEntry* Take(int size); + static void Return(PoolEntry* storage); + + static constexpr unsigned int pool_limit_ = 256; + static unsigned int pool4_size_; + static PoolEntry* pool4_; + static std::atomic_flag pool4_flag_; +}; + +template<> +class PoolManager> { + using PoolEntry = PoolStorage>; + using Managed = PoolEntry::Managed; + + template friend class PoolArray; + + static PoolEntry* Take(int size); + static void Return(PoolEntry* storage); + + static constexpr unsigned int pool_limit_ = 256; + static unsigned int pool4_size_; + static PoolEntry* pool4_; + static std::atomic_flag pool4_flag_; +}; + +} // namespace zeolite_internal + + class ReturnTuple : public ValueTuple { public: ReturnTuple(int size) : size_(size), data_(size_) {} @@ -202,9 +240,9 @@ ReturnTuple& operator = (ReturnTuple&&); int Size() const final; - S& At(int pos); - const S& At(int pos) const final; - const S& Only() const final; + BoxedValue& At(int pos); + const BoxedValue& At(int pos) const final; + const BoxedValue& Only() const final; private: ReturnTuple(const ReturnTuple&) = delete; @@ -212,20 +250,7 @@ void* operator new(std::size_t size) = delete; int size_; - PoolArray> data_; -}; - -template<> -class PoolManager*> { - using Managed = const S*; - using PoolEntry = PoolStorage; - - template friend class PoolArray; - - static PoolEntry* Take(int size); - static void Return(PoolEntry* storage); - - static constexpr unsigned int pool_limit_ = 256; + zeolite_internal::PoolArray data_; }; class ArgTuple : public ValueTuple { @@ -236,8 +261,8 @@ } int Size() const final; - const S& At(int pos) const final; - const S& Only() const final; + const BoxedValue& At(int pos) const final; + const BoxedValue& Only() const final; private: ArgTuple(const ArgTuple&) = delete; @@ -247,20 +272,7 @@ void* operator new(std::size_t size) = delete; int size_; - PoolArray*> data_; -}; - -template<> -class PoolManager> { - using Managed = S; - using PoolEntry = PoolStorage; - - template friend class PoolArray; - - static PoolEntry* Take(int size); - static void Return(PoolEntry* storage); - - static constexpr unsigned int pool_limit_ = 256; + zeolite_internal::PoolArray data_; }; class ParamTuple { @@ -282,25 +294,7 @@ void* operator new(std::size_t size) = delete; int size_; - PoolArray> data_; + zeolite_internal::PoolArray> data_; }; - -inline ReturnTuple FailWhenNull(ReturnTuple values) { - for (int i = 0; i < values.Size(); ++i) { - if (values.At(i) == nullptr) { - FAIL() << "Value at return tuple position " << i << " is null"; - } - } - return values; -} - -inline const ValueTuple& FailWhenNull(const ValueTuple& values) { - for (int i = 0; i < values.Size(); ++i) { - if (values.At(i) == nullptr) { - FAIL() << "Value at arg tuple position " << i << " is null"; - } - } - return values; -} #endif // TYPES_HPP_ diff --git a/bin/zeolite-setup.hs b/bin/zeolite-setup.hs --- a/bin/zeolite-setup.hs +++ b/bin/zeolite-setup.hs @@ -61,20 +61,26 @@ "lib/container", "lib/file", "lib/math", + "lib/thread", "tests" ] optionalLibraries :: [String] optionalLibraries = [ - "lib/thread" ] includePaths :: [String] includePaths = ["lib"] -cxxFlags :: [String] -cxxFlags = ["-O2", "-std=c++11"] +compileFlags :: [String] +compileFlags = ["-O2", "-std=c++11", "-fPIC"] +libraryFlags :: [String] +libraryFlags = ["-shared", "-fpic"] + +binaryFlags :: [String] +binaryFlags = ["-O2", "-std=c++11"] + createConfig :: IO LocalConfig createConfig = do clang <- findExecutables clangBinary @@ -82,13 +88,13 @@ ar <- findExecutables arBinary compiler <- promptChoice "Which clang-compatible C++ compiler should be used?" (clang ++ gcc) archiver <- promptChoice "Which ar-compatible archiver should be used?" ar - -- Cannot be overridden at this point. - let options = cxxFlags let config = LocalConfig { lcBackend = UnixBackend { - ucCxxBinary = compiler, - ucCxxOptions = options, - ucArBinary = archiver + ucCxxBinary = compiler, + ucCompileFlags = compileFlags, + ucLibraryFlags = libraryFlags, + ucBinaryFlags = binaryFlags, + ucArBinary = archiver }, lcResolver = SimpleResolver { srVisibleSystem = includePaths, diff --git a/bin/zeolite.hs b/bin/zeolite.hs --- a/bin/zeolite.hs +++ b/bin/zeolite.hs @@ -17,6 +17,8 @@ -- Author: Kevin P. Barry [ta0kira@gmail.com] import Control.Monad (when) +import Control.Monad.Trans +import GHC.IO.Handle import System.Directory import System.Environment import System.Exit @@ -51,7 +53,16 @@ let co' = getCompilerSuccess co (resolver,backend) <- loadConfig when (HelpNotNeeded /= (coHelp co')) $ errorFromIO $ showHelp >> exitFailure + tryCloseStdin runCompiler resolver backend co' + +tryCloseStdin :: TrackedErrorsIO () +tryCloseStdin = do + let result = errorFromIO $ withFile "/dev/null" ReadMode (flip hDuplicateTo stdin) + -- NOTE: Processing result more than once (e.g., error check followed by + -- conversion to warnings) could cause the operation to be executed again. + "In zeolite's attempt to block compiler and test input on stdin" ??> + (lift (toTrackedErrors result) >>= asCompilerWarnings) showHelp :: IO () showHelp = do diff --git a/example/hello/README.md b/example/hello/README.md --- a/example/hello/README.md +++ b/example/hello/README.md @@ -10,7 +10,7 @@ ZEOLITE_PATH=$(zeolite --get-path) # Compile the example. -zeolite -p "$ZEOLITE_PATH" -I lib/util -m HelloDemo example/hello +zeolite -p "$ZEOLITE_PATH/example/hello" -I lib/util --fast HelloDemo hello-demo.0rx # Execute the compiled binary. $ZEOLITE_PATH/example/hello/HelloDemo diff --git a/example/primes/README.md b/example/primes/README.md --- a/example/primes/README.md +++ b/example/primes/README.md @@ -35,14 +35,6 @@ ## Running -This example depends on the optional `lib/thread` library. That library is -included in the base package, but you might need to build it first. - -```shell -ZEOLITE_PATH=$(zeolite --get-path) -zeolite -p "$ZEOLITE_PATH" -r lib/thread -``` - To run the example: ```shell diff --git a/lib/container/sequence.0rp b/lib/container/sequence.0rp new file mode 100644 --- /dev/null +++ b/lib/container/sequence.0rp @@ -0,0 +1,18 @@ +/* ----------------------------------------------------------------------------- +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] + diff --git a/lib/container/sequence.0rt b/lib/container/sequence.0rt new file mode 100644 --- /dev/null +++ b/lib/container/sequence.0rt @@ -0,0 +1,18 @@ +/* ----------------------------------------------------------------------------- +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] + diff --git a/lib/container/sequence.0rx b/lib/container/sequence.0rx new file mode 100644 --- /dev/null +++ b/lib/container/sequence.0rx @@ -0,0 +1,71 @@ +/* ----------------------------------------------------------------------------- +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] + +@value interface MutableOrder<#n|> { + #n requires #self + + setNext (#n) -> (#self) +} + +concrete SequenceNode<#n|#x|> { + #n requires #self + + refines Order<#x> + refines MutableOrder<#n,#x> + + @type create (#x) -> (#self) + @type insert (#x,optional #n) -> (#self) +} + +define SequenceNode { + @value #x value + @value optional #n next + + create (x) { + return insert(x,empty) + } + + insert (x,n) { + return #self{ x, n } + } + + get () { + return value + } + + next () { + return next + } + + setNext (n) { + next <- n + return self + } +} + +concrete Temp { + @type sort<#x> + #x defines LessThan<#x> + (SequenceNode<#x>) -> () +} + +define Temp { + sort (list) + + +} diff --git a/lib/container/sorting.0rx b/lib/container/sorting.0rx --- a/lib/container/sorting.0rx +++ b/lib/container/sorting.0rx @@ -49,11 +49,11 @@ @value [ReadAt<#x>&WriteAt<#x>] seq inPlace (seq) { - \ (#self{ seq }).execute() + \ #self{ seq }.execute() } @value execute () -> () - execute () { + execute () { $NoTrace$ // Convert the container to a heap. traverse (Counter.revZeroIndexed(seq.size()/2) -> Int i) { \ sift(i,seq.size()) @@ -68,7 +68,7 @@ } @value sift (Int,Int) -> () - sift (start,size) { + sift (start,size) { $NoTrace$ scoped { Int last <- start Int indexLargest <- last @@ -94,7 +94,7 @@ } @value swap (Int,Int) -> () - swap (i,j) { + swap (i,j) { $NoTrace$ if (i != j) { #x temp <- seq.readAt(i) \ seq.writeAt(i,seq.readAt(j)) diff --git a/lib/container/src/Extension_Vector.cpp b/lib/container/src/Extension_Vector.cpp --- a/lib/container/src/Extension_Vector.cpp +++ b/lib/container/src/Extension_Vector.cpp @@ -36,17 +36,17 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -using VectorType = std::vector>; +using VectorType = std::vector; -S CreateValue_Vector(S parent, VectorType values); +BoxedValue CreateValue_Vector(S parent, 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)); + const BoxedValue& Var_arg1 = (args.At(0)); VectorType values; - const PrimInt size = TypeValue::Call(Var_arg1, Function_Container_size, ParamTuple(), ArgTuple()).Only()->AsInt(); + 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()); } @@ -62,7 +62,7 @@ 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(); + 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()); @@ -76,10 +76,10 @@ }; struct VectorOrder : public AnonymousOrder { - VectorOrder(S container, const VectorType& v) + VectorOrder(BoxedValue container, const VectorType& v) : AnonymousOrder(container, Function_Order_next, Function_Order_get), values(v) {} - S Call_next(const S& self) final { + BoxedValue Call_next(const BoxedValue& self) final { if (index+1 >= values.size()) { return Var_empty; } else { @@ -88,7 +88,7 @@ } } - S Call_get(const S& self) final { + BoxedValue Call_get(const BoxedValue& self) final { if (index >= values.size()) FAIL() << "iterated past end of Vector"; return values[index]; } @@ -101,57 +101,57 @@ inline ExtValue_Vector(S p, VectorType v) : Value_Vector(p), values(std::move(v)) {} - ReturnTuple Call_append(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_append(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Vector.append") - const S& Var_arg1 = (args.At(0)); + const BoxedValue& Var_arg1 = (args.At(0)); values.push_back(Var_arg1); return ReturnTuple(Var_self); } - ReturnTuple Call_defaultOrder(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_defaultOrder(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Vector.defaultOrder") if (values.empty()) { return ReturnTuple(Var_empty); } else { - return ReturnTuple(S_get(new VectorOrder(Var_self, values))); + return ReturnTuple(BoxedValue(new VectorOrder(Var_self, values))); } } - ReturnTuple Call_pop(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_pop(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Vector.pop") if (values.empty()) { BUILTIN_FAIL(Box_String(PrimString_FromLiteral("no elements left to pop"))) } - S value = values.back(); + BoxedValue value = values.back(); values.pop_back(); return ReturnTuple(value); } - ReturnTuple Call_push(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_push(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Vector.push") - const S& Var_arg1 = (args.At(0)); + const BoxedValue& 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 { + ReturnTuple Call_readAt(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Vector.readAt") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); + 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 { + ReturnTuple Call_size(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Vector.size") return ReturnTuple(Box_Int(values.size())); } - ReturnTuple Call_writeAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_writeAt(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Vector.writeAt") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); - const S& Var_arg2 = (args.At(1)); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); + const BoxedValue& Var_arg2 = (args.At(1)); if (Var_arg1 < 0 || Var_arg1 >= values.size()) { FAIL() << "index " << Var_arg1 << " is out of bounds"; } @@ -159,6 +159,7 @@ return ReturnTuple(Var_self); } + // vector<#x> VectorType values; }; @@ -172,8 +173,8 @@ }); return cache.GetOrCreate(params); } -S CreateValue_Vector(S parent, VectorType values) { - return S_get(new ExtValue_Vector(parent, values)); +BoxedValue CreateValue_Vector(S parent, VectorType values) { + return BoxedValue(new ExtValue_Vector(parent, values)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/file/src/Extension_RawFileReader.cpp b/lib/file/src/Extension_RawFileReader.cpp --- a/lib/file/src/Extension_RawFileReader.cpp +++ b/lib/file/src/Extension_RawFileReader.cpp @@ -25,7 +25,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_RawFileReader(S parent, const ValueTuple& args); +BoxedValue CreateValue_RawFileReader(S parent, const ValueTuple& args); struct ExtCategory_RawFileReader : public Category_RawFileReader { }; @@ -42,10 +42,10 @@ struct ExtValue_RawFileReader : public Value_RawFileReader { inline ExtValue_RawFileReader(S p, const ValueTuple& args) : Value_RawFileReader(p), - filename(args.At(0)->AsString()), + 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 { + ReturnTuple Call_freeResource(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("RawFileReader.freeResource") std::lock_guard lock(mutex); if (file) { @@ -54,7 +54,7 @@ return ReturnTuple(); } - ReturnTuple Call_getFileError(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_getFileError(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("RawFileReader.getFileError") std::lock_guard lock(mutex); if (!file) { @@ -69,17 +69,17 @@ return ReturnTuple(Var_empty); } - ReturnTuple Call_pastEnd(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_pastEnd(const BoxedValue& 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 { + ReturnTuple Call_readBlock(const BoxedValue& 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(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); if (Var_arg1 < 0) { FAIL() << "Read size " << Var_arg1 << " is invalid"; } @@ -118,8 +118,8 @@ static const auto cached = S_get(new ExtType_RawFileReader(CreateCategory_RawFileReader(), Params<0>::Type())); return cached; } -S CreateValue_RawFileReader(S parent, const ValueTuple& args) { - return S_get(new ExtValue_RawFileReader(parent, args)); +BoxedValue CreateValue_RawFileReader(S parent, const ValueTuple& args) { + return BoxedValue(new ExtValue_RawFileReader(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/file/src/Extension_RawFileWriter.cpp b/lib/file/src/Extension_RawFileWriter.cpp --- a/lib/file/src/Extension_RawFileWriter.cpp +++ b/lib/file/src/Extension_RawFileWriter.cpp @@ -25,7 +25,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_RawFileWriter(S parent, const ValueTuple& args); +BoxedValue CreateValue_RawFileWriter(S parent, const ValueTuple& args); struct ExtCategory_RawFileWriter : public Category_RawFileWriter { }; @@ -42,10 +42,10 @@ struct ExtValue_RawFileWriter : public Value_RawFileWriter { inline ExtValue_RawFileWriter(S p, const ValueTuple& args) : Value_RawFileWriter(p), - filename(args.At(0)->AsString()), + 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 { + ReturnTuple Call_freeResource(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("RawFileWriter.freeResource") std::lock_guard lock(mutex); if (file) { @@ -54,7 +54,7 @@ return ReturnTuple(); } - ReturnTuple Call_getFileError(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_getFileError(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("RawFileWriter.getFileError") std::lock_guard lock(mutex); if (!file) { @@ -69,11 +69,11 @@ return ReturnTuple(Var_empty); } - ReturnTuple Call_writeBlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_writeBlock(const BoxedValue& 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(); + const PrimString& Var_arg1 = args.At(0).AsString(); if (!file || file->rdstate() != std::ios::goodbit) { FAIL() << "Error writing file \"" << filename << "\""; } @@ -100,8 +100,8 @@ static const auto cached = S_get(new ExtType_RawFileWriter(CreateCategory_RawFileWriter(), Params<0>::Type())); return cached; } -S CreateValue_RawFileWriter(S parent, const ValueTuple& args) { - return S_get(new ExtValue_RawFileWriter(parent, args)); +BoxedValue CreateValue_RawFileWriter(S parent, const ValueTuple& args) { + return BoxedValue(new ExtValue_RawFileWriter(parent, args)); } #ifdef 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 @@ -102,7 +102,7 @@ testcase "read missing file crash" { crash require "do-not-create-this-file" - require "RawFileReader .*originally created" + require "RawFileReader .*creation" } unittest test { @@ -114,7 +114,7 @@ testcase "unwritable file crash" { crash require "testfile" - require "RawFileWriter .*originally created" + require "RawFileWriter .*creation" } unittest test { diff --git a/lib/math/categorical-tree.0rp b/lib/math/categorical-tree.0rp --- a/lib/math/categorical-tree.0rp +++ b/lib/math/categorical-tree.0rp @@ -40,19 +40,20 @@ // Get the sum of all weights in the distribution. @value getTotal () -> (Int) - // Set the relative weight of a category. + // Set the relative weight of a value. // // Notes: // - The weight must not be negative. + // - The sum of all weights (see getTotal()) must not exceed Int.maxBound(). @value setWeight (#c,Int) -> (#self) - // Get the relative weight of a category. + // Get the relative weight of a value. // // Notes: // - If the category isn't in the tree, its weight is 0. @value getWeight (#c) -> (Int) - // Return the category at the given offset. + // Return the value at the given offset. // // Notes: // - The offset must be within [0,getTotal()). A uniform selection in that diff --git a/lib/math/src/Extension_Math.cpp b/lib/math/src/Extension_Math.cpp --- a/lib/math/src/Extension_Math.cpp +++ b/lib/math/src/Extension_Math.cpp @@ -35,165 +35,165 @@ 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + 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(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); return ReturnTuple(Box_Int(std::abs(Var_arg1))); } }; diff --git a/lib/thread/README.md b/lib/thread/README.md --- a/lib/thread/README.md +++ b/lib/thread/README.md @@ -9,25 +9,13 @@ ## 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 thread-library -dependencies between different systems. - -1. If you are running Linux or FreeBSD, the config should work as-is. - - 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. +This library is automatically built by `zeolite-setup`. - ```shell - zeolite -p "$ZEOLITE_PATH" -t lib/thread - ``` +If you run into linker errors when building binaries or running tests, you might +need to update `link_flags` in `lib/thread/.zeolite-module` to either change or +remove dependence on `-lpthread`, then manually build the module again. - If you run into linker errors, you might need to go to step 1 and update the - `link_flags` in `.zeolite-module`. +```shell +ZEOLITE_PATH=$(zeolite --get-path) +zeolite -p "$ZEOLITE_PATH" -r lib/thread +``` diff --git a/lib/thread/src/Extension_Enumerated.cpp b/lib/thread/src/Extension_Enumerated.cpp --- a/lib/thread/src/Extension_Enumerated.cpp +++ b/lib/thread/src/Extension_Enumerated.cpp @@ -101,7 +101,7 @@ namespace ZEOLITE_PRIVATE_NAMESPACE { #endif // ZEOLITE_PRIVATE_NAMESPACE -S CreateValue_EnumeratedWait( +BoxedValue CreateValue_EnumeratedWait( S parent, S b, int i); struct ExtCategory_EnumeratedWait : public Category_EnumeratedWait { @@ -115,7 +115,7 @@ inline ExtValue_EnumeratedWait(S p, S b, int i) : Value_EnumeratedWait(p), barrier(b), index(i) {} - ReturnTuple Call_wait(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_wait(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("EnumeratedWait.wait") barrier->Wait(index); return ReturnTuple(Var_self); @@ -137,9 +137,9 @@ static const auto cached = S_get(new ExtType_EnumeratedWait(CreateCategory_EnumeratedWait(), Params<0>::Type())); return cached; } -S CreateValue_EnumeratedWait( +BoxedValue CreateValue_EnumeratedWait( S parent, S b, int i) { - return S_get(new ExtValue_EnumeratedWait(parent, b, i)); + return BoxedValue(new ExtValue_EnumeratedWait(parent, b, i)); } #ifdef ZEOLITE_PRIVATE_NAMESPACE @@ -152,8 +152,8 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_EnumeratedBarrier( - S parent, std::vector> w); +BoxedValue CreateValue_EnumeratedBarrier( + S parent, std::vector w); struct ExtCategory_EnumeratedBarrier : public Category_EnumeratedBarrier { }; @@ -163,14 +163,14 @@ ReturnTuple Call_new(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("EnumeratedBarrier.new") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); if (Var_arg1 < 0) { FAIL() << "Invalid barrier thread count " << Var_arg1; } - std::vector> waits; + std::vector waits; S barrier(Var_arg1? new Barrier(Var_arg1) : nullptr); for (int i = 0; i < Var_arg1; ++i) { - S wait = CreateValue_EnumeratedWait( + BoxedValue wait = CreateValue_EnumeratedWait( CreateType_EnumeratedWait(Params<0>::Type()), barrier, i); waits.push_back(wait); } @@ -179,24 +179,25 @@ }; struct ExtValue_EnumeratedBarrier : public Value_EnumeratedBarrier { - inline ExtValue_EnumeratedBarrier(S p, std::vector> w) + inline ExtValue_EnumeratedBarrier(S p, std::vector w) : Value_EnumeratedBarrier(p), waits(std::move(w)) {} - ReturnTuple Call_readAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_readAt(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("EnumeratedBarrier.readAt") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); + const PrimInt Var_arg1 = (args.At(0)).AsInt(); if (Var_arg1 < 0 || Var_arg1 >= waits.size()) { FAIL() << "index " << Var_arg1 << " is out of bounds"; } return ReturnTuple(waits[Var_arg1]); } - ReturnTuple Call_size(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_size(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("EnumeratedBarrier.size") return ReturnTuple(Box_Int(waits.size())); } - const std::vector> waits; + // vector + const std::vector waits; }; Category_EnumeratedBarrier& CreateCategory_EnumeratedBarrier() { @@ -207,9 +208,9 @@ static const auto cached = S_get(new ExtType_EnumeratedBarrier(CreateCategory_EnumeratedBarrier(), Params<0>::Type())); return cached; } -S CreateValue_EnumeratedBarrier( - S parent, std::vector> w) { - return S_get(new ExtValue_EnumeratedBarrier(parent, std::move(w))); +BoxedValue CreateValue_EnumeratedBarrier( + S parent, std::vector w) { + return BoxedValue(new ExtValue_EnumeratedBarrier(parent, std::move(w))); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/thread/src/Extension_ProcessThread.cpp b/lib/thread/src/Extension_ProcessThread.cpp --- a/lib/thread/src/Extension_ProcessThread.cpp +++ b/lib/thread/src/Extension_ProcessThread.cpp @@ -31,7 +31,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_ProcessThread(S parent, const ValueTuple& args); +BoxedValue CreateValue_ProcessThread(S parent, const ValueTuple& args); struct ExtCategory_ProcessThread : public Category_ProcessThread { }; @@ -49,7 +49,7 @@ inline ExtValue_ProcessThread(S p, const ValueTuple& args) : Value_ProcessThread(p), routine(args.Only()) {} - ReturnTuple Call_detach(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_detach(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ProcessThread.detach") S temp = thread; thread = nullptr; @@ -61,12 +61,12 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_isRunning(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_isRunning(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ProcessThread.isRunning") return ReturnTuple(Box_Bool(isJoinable(thread.get()))); } - ReturnTuple Call_join(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_join(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ProcessThread.join") S temp = thread; thread = nullptr; @@ -78,7 +78,7 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_start(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_start(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ProcessThread.start") if (isJoinable(thread.get())) { FAIL() << "thread is already running"; @@ -107,7 +107,8 @@ } } - const S routine; + // Routine + const BoxedValue routine; S thread; CAPTURE_CREATION("ProcessThread") }; @@ -120,8 +121,8 @@ static const auto cached = S_get(new ExtType_ProcessThread(CreateCategory_ProcessThread(), Params<0>::Type())); return cached; } -S CreateValue_ProcessThread(S parent, const ValueTuple& args) { - return S_get(new ExtValue_ProcessThread(parent, args)); +BoxedValue CreateValue_ProcessThread(S parent, const ValueTuple& args) { + return BoxedValue(new ExtValue_ProcessThread(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/thread/src/Extension_Realtime.cpp b/lib/thread/src/Extension_Realtime.cpp --- a/lib/thread/src/Extension_Realtime.cpp +++ b/lib/thread/src/Extension_Realtime.cpp @@ -21,6 +21,9 @@ #include #include +#include +#include + #include "category-source.hpp" #include "Streamlined_Realtime.hpp" #include "Category_Float.hpp" @@ -35,9 +38,10 @@ struct ExtType_Realtime : public Type_Realtime { inline ExtType_Realtime(Category_Realtime& p, Params<0>::Type params) : Type_Realtime(p, params) {} + ReturnTuple Call_sleepSeconds(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Realtime.sleepSeconds") - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + const PrimFloat Var_arg1 = (args.At(0)).AsFloat(); if (Var_arg1 < 0) { FAIL() << "Bad wait time " << Var_arg1; } @@ -51,6 +55,15 @@ } } return ReturnTuple(); + } + + ReturnTuple Call_monoSeconds(const S& Param_self, const ParamTuple& params, const ValueTuple& args) final { + TRACE_FUNCTION("Realtime.monoSeconds") + const auto time = std::chrono::steady_clock::now().time_since_epoch(); + const PrimFloat seconds = + (PrimFloat) std::chrono::duration_cast(time).count() / + (PrimFloat) 1000000.0; + return ReturnTuple(Box_Float(seconds)); } }; diff --git a/lib/thread/src/Extension_ThreadCondition.cpp b/lib/thread/src/Extension_ThreadCondition.cpp --- a/lib/thread/src/Extension_ThreadCondition.cpp +++ b/lib/thread/src/Extension_ThreadCondition.cpp @@ -32,7 +32,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_ThreadCondition(S parent); +BoxedValue CreateValue_ThreadCondition(S parent); struct ExtCategory_ThreadCondition : public Category_ThreadCondition { }; @@ -56,7 +56,7 @@ pthread_mutex_init(&mutex, &mutex_attr); } - ReturnTuple Call_lock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_lock(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ThreadCondition.lock") int error = 0; if ((error = pthread_mutex_lock(&mutex)) != 0) { @@ -65,7 +65,7 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_resumeAll(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_resumeAll(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ThreadCondition.resumeAll") int error = 0; if ((error = pthread_cond_broadcast(&cond)) != 0) { @@ -74,7 +74,7 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_resumeOne(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_resumeOne(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ThreadCondition.resumeOne") int error = 0; if ((error = pthread_cond_signal(&cond)) != 0) { @@ -83,10 +83,10 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_timedWait(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_timedWait(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ThreadCondition.timedWait") int error = 0; - const PrimFloat Var_arg1 = (args.At(0))->AsFloat(); + const PrimFloat Var_arg1 = (args.At(0)).AsFloat(); if (Var_arg1 < 0) { FAIL() << "Bad wait time " << Var_arg1; } @@ -106,7 +106,7 @@ return ReturnTuple(Box_Bool(true)); } - ReturnTuple Call_unlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_unlock(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ThreadCondition.unlock") int error = 0; if ((error = pthread_mutex_unlock(&mutex)) != 0) { @@ -115,7 +115,7 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_wait(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_wait(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("ThreadCondition.wait") int error = 0; if ((error = pthread_cond_wait(&cond, &mutex)) != 0) { @@ -154,8 +154,8 @@ static const auto cached = S_get(new ExtType_ThreadCondition(CreateCategory_ThreadCondition(), Params<0>::Type())); return cached; } -S CreateValue_ThreadCondition(S parent) { - return S_get(new ExtValue_ThreadCondition(parent)); +BoxedValue CreateValue_ThreadCondition(S parent) { + return BoxedValue(new ExtValue_ThreadCondition(parent)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/thread/testing.0rx b/lib/thread/testing.0rx --- a/lib/thread/testing.0rx +++ b/lib/thread/testing.0rx @@ -31,8 +31,10 @@ return InfiniteRoutine{ } } - run () { - while (true) {} + run () { $NoTrace$ + while (true) { + \ Realtime.sleepSeconds(60.0) + } } } diff --git a/lib/thread/thread.0rp b/lib/thread/thread.0rp --- a/lib/thread/thread.0rp +++ b/lib/thread/thread.0rp @@ -82,7 +82,7 @@ // @value weak Thread thread // // createAndRun () { - // return (MyRoutine{ empty }).start() + // return MyRoutine{ empty }.start() // } // // run () { diff --git a/lib/thread/time.0rp b/lib/thread/time.0rp --- a/lib/thread/time.0rp +++ b/lib/thread/time.0rp @@ -20,4 +20,13 @@ concrete Realtime { // Sleep for the given number of seconds. @type sleepSeconds (Float) -> () + + // Get a timestamp from a monotonic clock. + // + // Notes: + // - The absolute timestamp is fairly meaningless; use timestamp diffs + // instead, e.g., to compute the wall time of an operation. + // - In theory, this is microsecond-precise; however, the effective resolution + // could depend more on the kernel's latency. + @type monoSeconds () -> (Float) } diff --git a/lib/thread/time.0rt b/lib/thread/time.0rt --- a/lib/thread/time.0rt +++ b/lib/thread/time.0rt @@ -33,3 +33,27 @@ unittest test { \ Realtime.sleepSeconds(0.0) } + + +testcase "sleepSeconds() does not interfere with test timeout" { + crash + require "signal 14" + timeout 1 +} + +unittest test { + \ Realtime.sleepSeconds(5.0) +} + + +testcase "monoSeconds() diff is somewhat accurate" { + success + timeout 2 +} + +unittest test { + Float start <- Realtime.monoSeconds() + \ Realtime.sleepSeconds(0.5) + Float stop <- Realtime.monoSeconds() + \ Testing.checkBetween(stop-start,0.5,0.75) +} diff --git a/lib/util/helpers.0rt b/lib/util/helpers.0rt --- a/lib/util/helpers.0rt +++ b/lib/util/helpers.0rt @@ -21,36 +21,36 @@ } unittest orderHLessThan { - \ Testing.checkEquals(("").defaultOrder() `OrderH:lessThan` ("").defaultOrder(), false) - \ Testing.checkEquals(("a").defaultOrder() `OrderH:lessThan` ("abc").defaultOrder(),true) - \ Testing.checkEquals(("b").defaultOrder() `OrderH:lessThan` ("abc").defaultOrder(),false) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:lessThan` ("abc").defaultOrder(),false) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:lessThan` ("a").defaultOrder(), false) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:lessThan` ("b").defaultOrder(), true) + \ Testing.checkEquals("".defaultOrder() `OrderH:lessThan` "".defaultOrder(), false) + \ Testing.checkEquals("a".defaultOrder() `OrderH:lessThan` "abc".defaultOrder(),true) + \ Testing.checkEquals("b".defaultOrder() `OrderH:lessThan` "abc".defaultOrder(),false) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:lessThan` "abc".defaultOrder(),false) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:lessThan` "a".defaultOrder(), false) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:lessThan` "b".defaultOrder(), true) } unittest orderHLessThanWith { - \ Testing.checkEquals(("").defaultOrder() `OrderH:lessThanWith>` ("").defaultOrder(), false) - \ Testing.checkEquals(("a").defaultOrder() `OrderH:lessThanWith>` ("abc").defaultOrder(),true) - \ Testing.checkEquals(("b").defaultOrder() `OrderH:lessThanWith>` ("abc").defaultOrder(),true) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:lessThanWith>` ("abc").defaultOrder(),false) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:lessThanWith>` ("a").defaultOrder(), false) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:lessThanWith>` ("b").defaultOrder(), false) + \ Testing.checkEquals("".defaultOrder() `OrderH:lessThanWith>` "".defaultOrder(), false) + \ Testing.checkEquals("a".defaultOrder() `OrderH:lessThanWith>` "abc".defaultOrder(),true) + \ Testing.checkEquals("b".defaultOrder() `OrderH:lessThanWith>` "abc".defaultOrder(),true) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:lessThanWith>` "abc".defaultOrder(),false) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:lessThanWith>` "a".defaultOrder(), false) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:lessThanWith>` "b".defaultOrder(), false) } unittest orderHEquals { - \ Testing.checkEquals(("").defaultOrder() `OrderH:equals` ("").defaultOrder(), true) - \ Testing.checkEquals(("a").defaultOrder() `OrderH:equals` ("abc").defaultOrder(),false) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:equals` ("abc").defaultOrder(),true) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:equals` ("a").defaultOrder(), false) + \ Testing.checkEquals("".defaultOrder() `OrderH:equals` "".defaultOrder(), true) + \ Testing.checkEquals("a".defaultOrder() `OrderH:equals` "abc".defaultOrder(),false) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:equals` "abc".defaultOrder(),true) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:equals` "a".defaultOrder(), false) } unittest orderHEqualsWith { - \ Testing.checkEquals(("").defaultOrder() `OrderH:equalsWith` ("").defaultOrder(), true) - \ Testing.checkEquals(("a").defaultOrder() `OrderH:equalsWith` ("ABC").defaultOrder(),false) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:equalsWith` ("ABC").defaultOrder(),true) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:equalsWith` ("DEF").defaultOrder(),false) - \ Testing.checkEquals(("abc").defaultOrder() `OrderH:equalsWith` ("A").defaultOrder(), false) + \ Testing.checkEquals("".defaultOrder() `OrderH:equalsWith` "".defaultOrder(), true) + \ Testing.checkEquals("a".defaultOrder() `OrderH:equalsWith` "ABC".defaultOrder(),false) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:equalsWith` "ABC".defaultOrder(),true) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:equalsWith` "DEF".defaultOrder(),false) + \ Testing.checkEquals("abc".defaultOrder() `OrderH:equalsWith` "A".defaultOrder(), false) } unittest readAtHLessThan { @@ -98,7 +98,7 @@ @type toLower (Char) -> (Char) toLower (c) { if (c >= 'A' && c <= 'Z') { - return (c.asInt() - ('A').asInt() + ('a').asInt()).asChar() + return (c.asInt() - 'A'.asInt() + 'a'.asInt()).asChar() } else { return c } diff --git a/lib/util/input.0rt b/lib/util/input.0rt --- a/lib/util/input.0rt +++ b/lib/util/input.0rt @@ -87,3 +87,13 @@ String allContents <- TextReader.readAll(FakeFile.create()) \ Testing.checkEquals(allContents,"this is a partial line\nwith some more data\nand\nmore lines\nunfinished") } + + +testcase "stdin is empty in tests" { + success + timeout 1 +} + +unittest test { + \ Testing.checkEquals(TextReader.readAll(SimpleInput.stdin()),"") +} diff --git a/lib/util/parse.0rp b/lib/util/parse.0rp new file mode 100644 --- /dev/null +++ b/lib/util/parse.0rp @@ -0,0 +1,131 @@ +/* ----------------------------------------------------------------------------- +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] + +// Helpers to parse a full sequence of Char. +concrete ParseChars { + // Parses a Float. + // + // Args: + // - DefaultOrder: Decimal-format floating-point. + // + // Returns: + // - ErrorOr: The parsed value, or an error on parse failure. + // + // Notes: + // - At least one digit is required. + // - Leading +/- signs may be used. + // - A successful parse must consume the entire sequence. + // - Scientific notation is allowed, e.g., "10E-5". + // - This function does not check for overflow/underflow. + // + // Example: + // + // ErrorOr value <- ParseChars.float("123.456E5") + // if (value.isError()) { + // fail(value.getError()) + // } + @type float (DefaultOrder) -> (ErrorOr) + + // Parses an Int. + // + // Args: + // - DefaultOrder: Decimal-format integer. + // + // Returns: + // - ErrorOr: The parsed value, or an error on parse failure. + // + // Notes: + // - At least one digit is required. + // - Leading +/- signs may be used. + // - A successful parse must consume the entire sequence. + // - This function does not check for overflow/underflow. + // + // Example: + // + // ErrorOr value <- ParseChars.int("123") + // if (value.isError()) { + // fail(value.getError()) + // } + @type int (DefaultOrder) -> (ErrorOr) + + // Parses a hex-formatted Int. + // + // Args: + // - DefaultOrder: Hex-format integer. + // + // Returns: + // - ErrorOr: The parsed value, or an error on parse failure. + // + // Notes: + // - At least one digit is required. + // - Leading +/- signs may be used. + // - A successful parse must consume the entire sequence. + // - This function does not check for overflow/underflow. + // + // Example: + // + // ErrorOr value <- ParseChars.hexInt("123ABC") + // if (value.isError()) { + // fail(value.getError()) + // } + @type hexInt (DefaultOrder) -> (ErrorOr) + + // Parses a octal-formatted Int. + // + // Args: + // - DefaultOrder: Octal-format integer. + // + // Returns: + // - ErrorOr: The parsed value, or an error on parse failure. + // + // Notes: + // - At least one digit is required. + // - Leading +/- signs may be used. + // - A successful parse must consume the entire sequence. + // - This function does not check for overflow/underflow. + // + // Example: + // + // ErrorOr value <- ParseChars.octInt("755") + // if (value.isError()) { + // fail(value.getError()) + // } + @type octInt (DefaultOrder) -> (ErrorOr) + + // Parses a binary-formatted Int. + // + // Args: + // - DefaultOrder: Binary-format integer. + // + // Returns: + // - ErrorOr: The parsed value, or an error on parse failure. + // + // Notes: + // - At least one digit is required. + // - Leading +/- signs may be used. + // - A successful parse must consume the entire sequence. + // - This function does not check for overflow/underflow. + // + // Example: + // + // ErrorOr value <- ParseChars.binInt("10010") + // if (value.isError()) { + // fail(value.getError()) + // } + @type binInt (DefaultOrder) -> (ErrorOr) +} diff --git a/lib/util/parse.0rt b/lib/util/parse.0rt new file mode 100644 --- /dev/null +++ b/lib/util/parse.0rt @@ -0,0 +1,221 @@ +/* ----------------------------------------------------------------------------- +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 "ParseChars tests" { + success +} + +unittest floatNoDecimal { + \ UtilTesting.checkSuccessBetween(ParseChars.float("123"),122.9,123.1) +} + +unittest floatDecimalLeft { + \ UtilTesting.checkSuccessBetween(ParseChars.float(".123"),0.1229,0.1231) +} + +unittest floatDecimalRight { + \ UtilTesting.checkSuccessBetween(ParseChars.float("123."),122.9,123.1) +} + +unittest floatDecimalMiddle { + \ UtilTesting.checkSuccessBetween(ParseChars.float("123.456"),123.4559,123.4561) +} + +unittest floatLeadingTrailingZeros { + \ UtilTesting.checkSuccessBetween(ParseChars.float("000123.456000"),123.4559,123.4561) +} + +unittest floatNegative { + \ UtilTesting.checkSuccessBetween(ParseChars.float("-123.456"),-123.4561,-123.4559) +} + +unittest floatPositive { + \ UtilTesting.checkSuccessBetween(ParseChars.float("+123.456"),123.4559,123.4561) +} + +unittest floatNegativeDecimalLeft { + \ UtilTesting.checkSuccessBetween(ParseChars.float("-.456"),-0.4561,-0.4559) +} + +unittest floatExponentNoDecimal { + \ UtilTesting.checkSuccessBetween(ParseChars.float("123E5"),122.9E5,123.1E5) +} + +unittest floatNegativeExponent { + \ UtilTesting.checkSuccessBetween(ParseChars.float("123E-5"),122.9E-5,123.1E-5) +} + +unittest floatPositiveExponent { + \ UtilTesting.checkSuccessBetween(ParseChars.float("123E+5"),122.9E5,123.1E5) +} + +unittest floatExponentDecimalRight { + \ UtilTesting.checkSuccessBetween(ParseChars.float("123.E5"),122.9E5,123.1E5) +} + +unittest floatExponentDecimalLeft { + \ UtilTesting.checkSuccessBetween(ParseChars.float(".123E5"),122.9E2,123.1E2) +} + +unittest floatExponentDecimalMiddle { + \ UtilTesting.checkSuccessBetween(ParseChars.float("123.456E5"),123.4559E5,123.4561E5) +} + +unittest floatEmpty { + \ UtilTesting.checkError(ParseChars.float("")) +} + +unittest floatNoDigits { + \ UtilTesting.checkError(ParseChars.float(".")) +} + +unittest floatTwoDecimals { + \ UtilTesting.checkError(ParseChars.float("1.1.")) +} + +unittest floatExponentNoDigitsNoDecimal { + \ UtilTesting.checkError(ParseChars.float("E5")) +} + +unittest floatExponentNoDigitsDecimal { + \ UtilTesting.checkError(ParseChars.float(".E5")) +} + +unittest floatExponentNoDigitsSign { + \ UtilTesting.checkError(ParseChars.float("-E5")) +} + +unittest floatDecimalAfterExponent { + \ UtilTesting.checkError(ParseChars.float("1E.5")) +} + +unittest floatExponentExcessData { + \ UtilTesting.checkError(ParseChars.float("123E5Q")) +} + +unittest int { + \ UtilTesting.checkSuccess(ParseChars.int("1234"),1234) +} + +unittest intNegative { + \ UtilTesting.checkSuccess(ParseChars.int("-1234"),-1234) +} + +unittest intPositive { + \ UtilTesting.checkSuccess(ParseChars.int("+1234"),1234) +} + +unittest intLeadingZeros { + \ UtilTesting.checkSuccess(ParseChars.int("001234"),1234) +} + +unittest intEmpty { + \ UtilTesting.checkError(ParseChars.int("")) +} + +unittest intJustSign { + \ UtilTesting.checkError(ParseChars.int("-")) +} + +unittest intBadDigit { + \ UtilTesting.checkError(ParseChars.int("12A")) +} + +unittest hexInt { + \ UtilTesting.checkSuccess(ParseChars.hexInt("12AbCdEf"),\x12ABCDEF) +} + +unittest hexIntNegative { + \ UtilTesting.checkSuccess(ParseChars.hexInt("-12AbCdEf"),-\x12ABCDEF) +} + +unittest hexIntPositive { + \ UtilTesting.checkSuccess(ParseChars.hexInt("+12AbCdEf"),\x12ABCDEF) +} + +unittest hexIntLeadingZeros { + \ UtilTesting.checkSuccess(ParseChars.hexInt("0012AbCdEf"),\x12ABCDEF) +} + +unittest hexIntEmpty { + \ UtilTesting.checkError(ParseChars.hexInt("")) +} + +unittest hexIntJustSign { + \ UtilTesting.checkError(ParseChars.hexInt("-")) +} + +unittest hexIntBadDigit { + \ UtilTesting.checkError(ParseChars.hexInt("12Q")) +} + +unittest octInt { + \ UtilTesting.checkSuccess(ParseChars.octInt("127"),\o127) +} + +unittest octIntNegative { + \ UtilTesting.checkSuccess(ParseChars.octInt("-127"),-\o127) +} + +unittest octIntPositive { + \ UtilTesting.checkSuccess(ParseChars.octInt("+127"),\o127) +} + +unittest octIntLeadingZeros { + \ UtilTesting.checkSuccess(ParseChars.octInt("00127"),\o127) +} + +unittest octIntEmpty { + \ UtilTesting.checkError(ParseChars.octInt("")) +} + +unittest octIntJustSign { + \ UtilTesting.checkError(ParseChars.octInt("-")) +} + +unittest octIntBadDigit { + \ UtilTesting.checkError(ParseChars.octInt("19")) +} + +unittest binInt { + \ UtilTesting.checkSuccess(ParseChars.binInt("100101"),\b100101) +} + +unittest binIntNegative { + \ UtilTesting.checkSuccess(ParseChars.binInt("-100101"),-\b100101) +} + +unittest binIntPositive { + \ UtilTesting.checkSuccess(ParseChars.binInt("+100101"),\b100101) +} + +unittest binIntLeadingZeros { + \ UtilTesting.checkSuccess(ParseChars.binInt("00100101"),\b100101) +} + +unittest binIntEmpty { + \ UtilTesting.checkError(ParseChars.binInt("")) +} + +unittest binIntJustSign { + \ UtilTesting.checkError(ParseChars.binInt("-")) +} + +unittest binIntBadDigit { + \ UtilTesting.checkError(ParseChars.binInt("12")) +} diff --git a/lib/util/parse.0rx b/lib/util/parse.0rx new file mode 100644 --- /dev/null +++ b/lib/util/parse.0rx @@ -0,0 +1,299 @@ +/* ----------------------------------------------------------------------------- +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] + +define ParseChars { + float (data) { + Float total <- 0.0 + Float sign <- 0.0 + Bool hasDigit <- false + Bool needExpDigits <- false + + optional Order curr <- data.defaultOrder() + + // Parse to the left of '.'. + while (present(curr)) { + Char c <- require(curr).get() + curr <- require(curr).next() + $ReadOnly[c]$ + $Hidden[curr]$ + if (sign == 0.0) { + if (c == '-') { + sign <- -1.0 + continue + } elif (c == '+') { + sign <- 1.0 + continue + } else { + sign <- 1.0 + } + } + if (c >= '0' && c <= '9') { + hasDigit <- true + total <- 10.0*total+(c.asInt() - '0'.asInt()).asFloat() + continue + } + if (c == '.') { + break + } + if (c == 'E' || c == 'e') { + if (!hasDigit) { + return autoFail(c) + } else { + needExpDigits <- true + break + } + } + return autoFail(c) + } + + if (!needExpDigits) { + + Float decimal <- 0.1 + + // Parse to the right of '.'. + while (present(curr)) { + Char c <- require(curr).get() + curr <- require(curr).next() + $ReadOnly[c]$ + $Hidden[curr]$ + if (c >= '0' && c <= '9') { + hasDigit <- true + total <- total+decimal*(c.asInt() - '0'.asInt()).asFloat() + decimal <- decimal/10.0 + continue + } + if (c == 'E' || c == 'e') { + if (!hasDigit) { + return autoFail(c) + } else { + needExpDigits <- true + break + } + } + return autoFail(c) + } + + } + + if (!hasDigit) { + return ErrorOr:error("missing digits in Float value") + } + + total <- sign*total + $Hidden[sign,hasDigit]$ + + Int expSign <- 0 + Int exp <- 0 + + if (needExpDigits) { + + // Parse exponent. + while (present(curr)) { + Char c <- require(curr).get() + curr <- require(curr).next() + $ReadOnly[c]$ + $Hidden[curr,total]$ + if (expSign == 0) { + if (c == '-') { + expSign <- -1 + continue + } elif (c == '+') { + expSign <- 1 + continue + } else { + expSign <- 1 + } + } + if (c >= '0' && c <= '9') { + needExpDigits <- false + exp <- 10*exp+(c.asInt() - '0'.asInt()) + continue + } + return autoFail(c) + } + + } + + if (present(curr)) { + return autoFail(require(curr).get()) + } + + if (needExpDigits) { + return ErrorOr:error("missing digits in Float exponent") + } + + traverse (Counter.zeroIndexed(exp) -> _) { + if (expSign > 0) { + total <- 10.0*total + } else { + total <- total/10.0 + } + } + + return ErrorOr:value(total) + } + + int (data) { + Int total <- 0 + Int sign <- 0 + Bool hasDigit <- false + + traverse (data.defaultOrder() -> Char c) { + if (sign == 0) { + if (c == '-') { + sign <- -1 + continue + } elif (c == '+') { + sign <- 1 + continue + } else { + sign <- 1 + } + } + if (c >= '0' && c <= '9') { + hasDigit <- true + total <- 10*total+(c.asInt() - '0'.asInt()) + continue + } + return autoFail(c) + } + + if (!hasDigit) { + return ErrorOr:error("missing digits in Int value") + } + + return ErrorOr:value(sign*total) + } + + hexInt (data) { + Int total <- 0 + Int sign <- 0 + Bool hasDigit <- false + + traverse (data.defaultOrder() -> Char c) { + if (sign == 0) { + if (c == '-') { + sign <- -1 + continue + } elif (c == '+') { + sign <- 1 + continue + } else { + sign <- 1 + } + } + if (c >= '0' && c <= '9') { + hasDigit <- true + total <- 16*total+(c.asInt() - '0'.asInt()) + continue + } + if (c >= 'a' && c <= 'f') { + hasDigit <- true + total <- 16*total+(c.asInt() - 'a'.asInt() + 10) + continue + } + if (c >= 'A' && c <= 'F') { + hasDigit <- true + total <- 16*total+(c.asInt() - 'A'.asInt() + 10) + continue + } + return autoFail(c) + } + + if (!hasDigit) { + return ErrorOr:error("missing digits in Int value") + } + + return ErrorOr:value(sign*total) + } + + octInt (data) { + Int total <- 0 + Int sign <- 0 + Bool hasDigit <- false + + traverse (data.defaultOrder() -> Char c) { + if (sign == 0) { + if (c == '-') { + sign <- -1 + continue + } elif (c == '+') { + sign <- 1 + continue + } else { + sign <- 1 + } + } + if (c >= '0' && c <= '7') { + hasDigit <- true + total <- 8*total+(c.asInt() - '0'.asInt()) + continue + } + return autoFail(c) + } + + if (!hasDigit) { + return ErrorOr:error("missing digits in Int value") + } + + return ErrorOr:value(sign*total) + } + + binInt (data) { + Int total <- 0 + Int sign <- 0 + Bool hasDigit <- false + + traverse (data.defaultOrder() -> Char c) { + if (sign == 0) { + if (c == '-') { + sign <- -1 + continue + } elif (c == '+') { + sign <- 1 + continue + } else { + sign <- 1 + } + } + if (c >= '0' && c <= '1') { + hasDigit <- true + total <- 2*total+(c.asInt() - '0'.asInt()) + continue + } + return autoFail(c) + } + + if (!hasDigit) { + return ErrorOr:error("missing digits in Int value") + } + + return ErrorOr:value(sign*total) + } + + @type autoFail<#x> (Char) -> (ErrorOr) + autoFail (c) { + return ErrorOr:error(String.builder() + .append("failed to parse ") + .append(typename<#x>().formatted()) + .append(" at '") + .append(c.formatted()) + .append("'") + .build()) + } +} diff --git a/lib/util/src/Extension_Argv.cpp b/lib/util/src/Extension_Argv.cpp --- a/lib/util/src/Extension_Argv.cpp +++ b/lib/util/src/Extension_Argv.cpp @@ -22,10 +22,10 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_Argv(S parent, int st, int sz); +BoxedValue CreateValue_Argv(S parent, int st, int sz); namespace { -extern const S& Var_global; +extern const BoxedValue& Var_global; } // namespace struct ExtCategory_Argv : public Category_Argv { @@ -44,28 +44,28 @@ inline ExtValue_Argv(S p, int st, int sz) : Value_Argv(p), start(st), size(sz) {} - ReturnTuple Call_readAt(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_readAt(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("Argv.readAt") - const PrimInt Var_arg1 = (args.At(0))->AsInt(); + 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 { + ReturnTuple Call_size(const BoxedValue& 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 { + ReturnTuple Call_subSequence(const BoxedValue& 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(); + 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, start + Var_arg1, Var_arg2))); + return ReturnTuple(BoxedValue(new ExtValue_Argv(parent, start + Var_arg1, Var_arg2))); } inline int GetSize() const { return size < 0 ? Argv::ArgCount() : size; } @@ -75,7 +75,7 @@ }; namespace { -const S& Var_global = *new S(new ExtValue_Argv(CreateType_Argv(Params<0>::Type()), 0, -1)); +const BoxedValue& Var_global = *new BoxedValue(new ExtValue_Argv(CreateType_Argv(Params<0>::Type()), 0, -1)); } // namespace Category_Argv& CreateCategory_Argv() { @@ -86,8 +86,8 @@ static const auto cached = S_get(new ExtType_Argv(CreateCategory_Argv(), Params<0>::Type())); return cached; } -S CreateValue_Argv(S parent, int st, int sz) { - return S_get(new ExtValue_Argv(parent, st, sz)); +BoxedValue CreateValue_Argv(S parent, int st, int sz) { + return BoxedValue(new ExtValue_Argv(parent, st, sz)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/src/Extension_MutexLock.cpp b/lib/util/src/Extension_MutexLock.cpp --- a/lib/util/src/Extension_MutexLock.cpp +++ b/lib/util/src/Extension_MutexLock.cpp @@ -28,7 +28,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_MutexLock(S parent, const ValueTuple& args); +BoxedValue CreateValue_MutexLock(S parent, const ValueTuple& args); struct ExtCategory_MutexLock : public Category_MutexLock { }; @@ -45,31 +45,32 @@ struct ExtValue_MutexLock : public Value_MutexLock { inline ExtValue_MutexLock(S p, const ValueTuple& args) : Value_MutexLock(p), mutex(args.Only()) { - TypeValue::Call(mutex, Function_Mutex_lock, ParamTuple(), ArgTuple()); + TypeValue::Call(BoxedValue::Require(mutex), Function_Mutex_lock, ParamTuple(), ArgTuple()); } - ReturnTuple Call_freeResource(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_freeResource(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("MutexLock.freeResource") TRACE_CREATION - if (!mutex) { + if (!BoxedValue::Present(mutex)) { FAIL() << "MutexLock freed multiple times"; } else { TypeValue::Call(mutex, Function_Mutex_unlock, ParamTuple(), ArgTuple()); - mutex = nullptr; + mutex = Var_empty; } return ReturnTuple(); } ~ExtValue_MutexLock() { - if (mutex) { + if (BoxedValue::Present(mutex)) { TRACE_CREATION - TypeValue::Call(mutex, Function_Mutex_unlock, ParamTuple(), ArgTuple()); - mutex = nullptr; + TypeValue::Call(BoxedValue::Require(mutex), Function_Mutex_unlock, ParamTuple(), ArgTuple()); + mutex = Var_empty; FAIL() << "MutexLock not freed with freeResource()"; } } - S mutex; + // optional Mutex + BoxedValue mutex; CAPTURE_CREATION("MutexLock") }; @@ -81,8 +82,8 @@ static const auto cached = S_get(new ExtType_MutexLock(CreateCategory_MutexLock(), Params<0>::Type())); return cached; } -S CreateValue_MutexLock(S parent, const ValueTuple& args) { - return S_get(new ExtValue_MutexLock(parent, args)); +BoxedValue CreateValue_MutexLock(S parent, const ValueTuple& args) { + return BoxedValue(new ExtValue_MutexLock(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/src/Extension_SimpleInput.cpp b/lib/util/src/Extension_SimpleInput.cpp --- a/lib/util/src/Extension_SimpleInput.cpp +++ b/lib/util/src/Extension_SimpleInput.cpp @@ -26,7 +26,7 @@ #endif // ZEOLITE_PUBLIC_NAMESPACE namespace { -extern const S& Var_stdin; +extern const BoxedValue& Var_stdin; } // namespace struct ExtCategory_SimpleInput : public Category_SimpleInput { @@ -44,16 +44,16 @@ struct ExtValue_SimpleInput : public Value_SimpleInput { inline ExtValue_SimpleInput(S p, const ValueTuple& args) : Value_SimpleInput(p) {} - ReturnTuple Call_pastEnd(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_pastEnd(const BoxedValue& 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 { + ReturnTuple Call_readBlock(const BoxedValue& 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(); + const int size = args.At(0).AsInt(); if (size < 0) { FAIL() << "Read size " << size << " is invalid"; } @@ -72,7 +72,7 @@ }; namespace { -const S& Var_stdin = *new S(new ExtValue_SimpleInput(CreateType_SimpleInput(Params<0>::Type()), ArgTuple())); +const BoxedValue& Var_stdin = *new BoxedValue(new ExtValue_SimpleInput(CreateType_SimpleInput(Params<0>::Type()), ArgTuple())); } // namespace Category_SimpleInput& CreateCategory_SimpleInput() { diff --git a/lib/util/src/Extension_SimpleMutex.cpp b/lib/util/src/Extension_SimpleMutex.cpp --- a/lib/util/src/Extension_SimpleMutex.cpp +++ b/lib/util/src/Extension_SimpleMutex.cpp @@ -27,7 +27,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_SimpleMutex(S parent); +BoxedValue CreateValue_SimpleMutex(S parent); struct ExtCategory_SimpleMutex : public Category_SimpleMutex { }; @@ -44,13 +44,13 @@ struct ExtValue_SimpleMutex : public Value_SimpleMutex { inline ExtValue_SimpleMutex(S p) : Value_SimpleMutex(p) {} - ReturnTuple Call_lock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_lock(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("SimpleMutex.lock") mutex.lock(); return ReturnTuple(Var_self); } - ReturnTuple Call_unlock(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_unlock(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("SimpleMutex.unlock") mutex.unlock(); return ReturnTuple(Var_self); @@ -67,8 +67,8 @@ 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)); +BoxedValue CreateValue_SimpleMutex(S parent) { + return BoxedValue(new ExtValue_SimpleMutex(parent)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/lib/util/src/Extension_SimpleOutput.cpp b/lib/util/src/Extension_SimpleOutput.cpp --- a/lib/util/src/Extension_SimpleOutput.cpp +++ b/lib/util/src/Extension_SimpleOutput.cpp @@ -27,9 +27,9 @@ #endif // ZEOLITE_PUBLIC_NAMESPACE namespace { -extern const S& Var_stdout; -extern const S& Var_stderr; -extern const S& Var_error; +extern const BoxedValue& Var_stdout; +extern const BoxedValue& Var_stderr; +extern const BoxedValue& Var_error; } // namespace struct ExtCategory_SimpleOutput : public Category_SimpleOutput { @@ -66,19 +66,19 @@ inline ExtValue_SimpleOutput(S p, S w) : Value_SimpleOutput(p), writer(w) {} - ReturnTuple Call_flush(const S& Var_self, const ParamTuple& params, const ValueTuple& args) final { + ReturnTuple Call_flush(const BoxedValue& 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 { + ReturnTuple Call_write(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("SimpleOutput.write") - const S& Var_arg1 = (args.At(0)); + const BoxedValue& Var_arg1 = (args.At(0)); std::lock_guard lock(mutex); writer->Write(TypeValue::Call(args.At(0), Function_Formatted_formatted, - ParamTuple(), ArgTuple()).Only()->AsString()); + ParamTuple(), ArgTuple()).Only().AsString()); return ReturnTuple(); } @@ -115,9 +115,9 @@ std::ostringstream output; }; -const S& Var_stdout = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), S_get(new StreamWriter(std::cout)))); -const S& Var_stderr = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), S_get(new StreamWriter(std::cerr)))); -const S& Var_error = *new S(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), S_get(new ErrorWriter()))); +const BoxedValue& Var_stdout = *new BoxedValue(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), S_get(new StreamWriter(std::cout)))); +const BoxedValue& Var_stderr = *new BoxedValue(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), S_get(new StreamWriter(std::cerr)))); +const BoxedValue& Var_error = *new BoxedValue(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), S_get(new ErrorWriter()))); } // namespace diff --git a/lib/util/testing.0rp b/lib/util/testing.0rp new file mode 100644 --- /dev/null +++ b/lib/util/testing.0rp @@ -0,0 +1,50 @@ +/* ----------------------------------------------------------------------------- +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$ + +// General lib/util helpers for use in unit tests. +concrete UtilTesting { + // Check the value for an ErrorOr error. Crashes if it is not an error. + // + // Args: + // - ErrorOr: Actual value. + @type checkError (ErrorOr) -> () + + // Check the values for equality. Crashes if they are not equal. + // + // Args: + // - ErrorOr<#x>: Actual value. + // - #x: Expected value. + @type checkSuccess<#x> + #x requires Formatted + #x defines Equals<#x> + (ErrorOr<#x>,#x) -> () + + // Check that the value is within a range. Crashes if it is not in the range. + // + // Args: + // - ErrorOr<#x>: Actual value. + // - #x: Lower bound. + // - #x: Upper bound. + @type checkSuccessBetween<#x> + #x requires Formatted + #x defines Equals<#x> + #x defines LessThan<#x> + (ErrorOr<#x>,#x,#x) -> () +} diff --git a/lib/util/testing.0rt b/lib/util/testing.0rt new file mode 100644 --- /dev/null +++ b/lib/util/testing.0rt @@ -0,0 +1,96 @@ +/* ----------------------------------------------------------------------------- +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 "UtilTesting.checkError with error" { + success +} + +unittest test { + \ UtilTesting.checkError(ErrorOr:error("failure")) +} + + +testcase "UtilTesting.checkError with value" { + crash + require "message" +} + +unittest test { + \ UtilTesting.checkError(ErrorOr:value("message")) +} + + +testcase "UtilTesting.checkSuccess success" { + success +} + +unittest test { + \ UtilTesting.checkSuccess(ErrorOr:value("message"),"message") +} + + +testcase "UtilTesting.checkSuccess bad value" { + crash + require "message" + require "foo" +} + +unittest test { + \ UtilTesting.checkSuccess(ErrorOr:value("foo"),"message") +} + + +testcase "UtilTesting.checkSuccess with error" { + crash + require "message" + require "failure" +} + +unittest test { + \ UtilTesting.checkSuccess(ErrorOr:error("failure"),"message") +} + + +testcase "UtilTesting.checkSuccessBetween success" { + success +} + +unittest test { + \ UtilTesting.checkSuccessBetween(ErrorOr:value(1),0,2) +} + + +testcase "UtilTesting.checkSuccess bad value" { + crash + require "7.+0.*2" +} + +unittest test { + \ UtilTesting.checkSuccessBetween(ErrorOr:value(7),0,2) +} + + +testcase "UtilTesting.checkSuccess with error" { + crash + require "0.*2" + require "failure" +} + +unittest test { + \ UtilTesting.checkSuccessBetween(ErrorOr:error("failure"),0,2) +} diff --git a/lib/util/testing.0rx b/lib/util/testing.0rx new file mode 100644 --- /dev/null +++ b/lib/util/testing.0rx @@ -0,0 +1,58 @@ +/* ----------------------------------------------------------------------------- +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 UtilTesting { + checkError (x) { + if (!x.isError()) { + fail(String.builder() + .append("expected an error but got value ") + .append(x.getValue().formatted()) + .build()) + } + } + + checkSuccess (x,y) { + if (x.isError()) { + fail(String.builder() + .append("expected ") + .append(y.formatted()) + .append(" but got error ") + .append(x.getError().formatted()) + .build()) + } else { + \ Testing.checkEquals(x.getValue(),y) + } + } + + checkSuccessBetween (x,l,h) { + if (x.isError()) { + fail(String.builder() + .append("expected value between ") + .append(l.formatted()) + .append(" and ") + .append(h.formatted()) + .append(" but got error ") + .append(x.getError().formatted()) + .build()) + } else { + \ Testing.checkBetween(x.getValue(),l,h) + } + } +} diff --git a/src/Base/CompilerError.hs b/src/Base/CompilerError.hs --- a/src/Base/CompilerError.hs +++ b/src/Base/CompilerError.hs @@ -81,6 +81,7 @@ isCompilerErrorT :: (Monad m, ErrorContextM (t m)) => t m a -> m Bool isCompilerSuccessT :: (Monad m, ErrorContextM (t m)) => t m a -> m Bool isCompilerSuccessT = fmap not . isCompilerErrorT + ifElseSuccessT :: (Monad m, ErrorContextM (t m)) => t m a -> m () -> m () -> t m a ( m a -> String -> m a ( CompilerMessage @@ -81,22 +82,22 @@ getCompilerWarnings = runIdentity . getCompilerWarningsT getCompilerErrorT :: Monad m => TrackedErrorsT m a -> m CompilerMessage -getCompilerErrorT = fmap cfErrors . citState +getCompilerErrorT = fmap cfErrors . tetState getCompilerSuccessT :: Monad m => TrackedErrorsT m a -> m a -getCompilerSuccessT = fmap csData . citState +getCompilerSuccessT = fmap csData . tetState getCompilerWarningsT :: Monad m => TrackedErrorsT m a -> m CompilerMessage -getCompilerWarningsT = fmap getWarnings . citState +getCompilerWarningsT = fmap getWarnings . tetState fromTrackedErrors :: Monad m => TrackedErrors a -> TrackedErrorsT m a fromTrackedErrors x = runIdentity $ do - x' <- citState x + x' <- tetState x return $ TrackedErrorsT $ return x' asCompilerWarnings :: Monad m => TrackedErrors a -> TrackedErrorsT m () asCompilerWarnings x = runIdentity $ do - x' <- citState x + x' <- tetState x return $ TrackedErrorsT $ return $ case x' of (CompilerFail ws es) -> CompilerSuccess (ws <> es) [] () @@ -104,7 +105,7 @@ asCompilerError :: Monad m => TrackedErrors a -> TrackedErrorsT m () asCompilerError x = runIdentity $ do - x' <- citState x + x' <- tetState x return $ TrackedErrorsT $ return $ case x' of (CompilerSuccess ws bs _) -> includeBackground bs $ CompilerFail mempty ws @@ -112,7 +113,7 @@ toTrackedErrors :: Monad m => TrackedErrorsT m a -> m (TrackedErrors a) toTrackedErrors x = do - x' <- citState x + x' <- tetState x return $ TrackedErrorsT $ return x' tryTrackedErrorsIO :: String -> String -> TrackedErrorsIO a -> IO a @@ -152,11 +153,11 @@ showAs m = (m:) . map (" " ++) instance Show a => Show (TrackedErrors a) where - show = show . runIdentity . citState + show = show . runIdentity . tetState instance (Functor m, Monad m) => Functor (TrackedErrorsT m) where fmap f x = TrackedErrorsT $ do - x' <- citState x + x' <- tetState x case x' of CompilerFail w e -> return $ CompilerFail w e -- Not the same a. CompilerSuccess w b d -> return $ CompilerSuccess w b (f d) @@ -164,8 +165,8 @@ instance (Applicative m, Monad m) => Applicative (TrackedErrorsT m) where pure = TrackedErrorsT .return . CompilerSuccess mempty [] f <*> x = TrackedErrorsT $ do - f' <- citState f - x' <- citState x + f' <- tetState f + x' <- tetState x case (f',x') of (CompilerFail w e,_) -> return $ CompilerFail w e -- Not the same a. @@ -176,11 +177,11 @@ instance Monad m => Monad (TrackedErrorsT m) where x >>= f = TrackedErrorsT $ do - x' <- citState x + x' <- tetState x case x' of CompilerFail w e -> return $ CompilerFail w e -- Not the same a. CompilerSuccess w b d -> do - d2 <- citState $ f d + d2 <- tetState $ f d return $ includeBackground b $ includeWarnings w d2 return = pure @@ -198,19 +199,19 @@ instance Monad m => ErrorContextM (TrackedErrorsT m) where compilerErrorM e = TrackedErrorsT $ return $ CompilerFail mempty $ compilerMessage e withContextM x c = TrackedErrorsT $ do - x' <- citState x + x' <- tetState x case x' of CompilerFail w e -> return $ CompilerFail (pushWarningScope c w) (pushErrorScope c e) CompilerSuccess w bs x2 -> return $ CompilerSuccess (pushWarningScope c w) bs x2 summarizeErrorsM x e2 = TrackedErrorsT $ do - x' <- citState x + x' <- tetState x case x' of CompilerFail w e -> return $ CompilerFail w (pushErrorScope e2 e) x2 -> return x2 compilerWarningM w = TrackedErrorsT (return $ CompilerSuccess (compilerMessage w) [] ()) compilerBackgroundM b = TrackedErrorsT (return $ CompilerSuccess mempty [b] ()) resetBackgroundM x = TrackedErrorsT $ do - x' <- citState x + x' <- tetState x case x' of CompilerSuccess w _ d -> return $ CompilerSuccess w [] d x2 -> return x2 @@ -227,14 +228,20 @@ instance ErrorContextT TrackedErrorsT where isCompilerErrorT x = do - x' <- citState x + x' <- tetState x case x' of CompilerFail _ _ -> return True - _ -> return False + _ -> return False + ifElseSuccessT x success failure = TrackedErrorsT $ do + x' <- tetState x + case x' of + CompilerSuccess _ _ _ -> success + _ -> failure + return x' combineResults :: (Monad m, Foldable f) => ([TrackedErrorsState a] -> TrackedErrorsState b) -> f (TrackedErrorsT m a) -> TrackedErrorsT m b -combineResults f = TrackedErrorsT . fmap f . sequence . map citState . foldr (:) [] +combineResults f = TrackedErrorsT . fmap f . sequence . map tetState . foldr (:) [] getWarnings :: TrackedErrorsState a -> CompilerMessage getWarnings (CompilerFail w _) = w diff --git a/src/Cli/CompileOptions.hs b/src/Cli/CompileOptions.hs --- a/src/Cli/CompileOptions.hs +++ b/src/Cli/CompileOptions.hs @@ -24,6 +24,7 @@ ExtraSource(..), ForceMode(..), HelpMode(..), + LinkerMode(..), emptyCompileOptions, getLinkFlags, getSourceCategories, @@ -102,6 +103,7 @@ CompileBinary { cbCategory :: CategoryName, cbFunction :: FunctionName, + cbLinker :: LinkerMode, cbOutputName :: FilePath, cbLinkFlags :: [String] } | @@ -123,9 +125,11 @@ CompileUnspecified deriving (Eq,Show) +data LinkerMode = LinkStatic | LinkDynamic deriving (Eq,Show) + isCompileBinary :: CompileMode -> Bool -isCompileBinary (CompileBinary _ _ _ _) = True -isCompileBinary _ = False +isCompileBinary (CompileBinary _ _ _ _ _) = True +isCompileBinary _ = False isCompileFast :: CompileMode -> Bool isCompileFast (CompileFast _ _ _) = True @@ -157,6 +161,6 @@ maybeDisableHelp h = h getLinkFlags :: CompileMode -> [String] -getLinkFlags (CompileBinary _ _ _ lf) = lf -getLinkFlags (CompileIncremental lf) = lf -getLinkFlags _ = [] +getLinkFlags (CompileBinary _ _ _ _ lf) = lf +getLinkFlags (CompileIncremental lf) = lf +getLinkFlags _ = [] diff --git a/src/Cli/Compiler.hs b/src/Cli/Compiler.hs --- a/src/Cli/Compiler.hs +++ b/src/Cli/Compiler.hs @@ -30,7 +30,6 @@ import Data.Time.LocalTime (getZonedTime) import System.Directory import System.FilePath -import System.Posix.Temp (mkstemps) import System.IO import qualified Data.Map as Map import qualified Data.Set as Set @@ -138,13 +137,17 @@ let (osCat,osOther) = partitionEithers os2 let os1' = resolveObjectDeps (deps1' ++ deps2) path path (os1 ++ osCat) warnPublic resolver (p d) pc dc os1' is + let allObjects = os1' ++ osOther ++ map OtherObjectFile os' + createCachePath (p d) + let libraryName = getCachedPath (p d) "" (show ns0 ++ ".so") + ls <- createLibrary libraryName (getLinkFlags m) (deps1' ++ deps2) allObjects let cm2 = CompileMetadata { cmVersionHash = compilerHash, cmPath = path, cmPublicNamespace = ns0, cmPrivateNamespace = ns1, cmPublicDeps = as, - cmPrivateDeps = as2, + cmPrivateDeps = if isBase then as2 else (base:as2), cmPublicCategories = sort pc, cmPrivateCategories = sort tc, cmPublicSubdirs = [s0], @@ -154,6 +157,7 @@ cmTestFiles = sort ts2, cmHxxFiles = sort hxx', cmCxxFiles = sort cxx, + cmLibraries = ls, cmBinaries = [], cmLinkFlags = getLinkFlags m, cmObjectFiles = os1' ++ osOther ++ map OtherObjectFile os' @@ -176,6 +180,7 @@ cmHxxFiles = cmHxxFiles cm2, cmCxxFiles = cmCxxFiles cm2, cmBinaries = bs, + cmLibraries = cmLibraries cm2, cmLinkFlags = cmLinkFlags cm2, cmObjectFiles = cmObjectFiles cm2 } @@ -213,8 +218,8 @@ coUsesCategory = c `Set.delete` allDeps, coOutput = [] } - compileExtraSource _ _ paths (OtherSource f2) = do - f2' <- compileExtraFile True (NoNamespace,NoNamespace) paths f2 + compileExtraSource (ns0,ns1) _ paths (OtherSource f2) = do + f2' <- compileExtraFile True (ns0,ns1) paths f2 case f2' of Just o -> return [Right $ OtherObjectFile o] Nothing -> return [] @@ -231,32 +236,44 @@ fmap Just $ runCxxCommand backend command | isSuffixOf ".a" f2 || isSuffixOf ".o" f2 = return (Just f2) | otherwise = return Nothing - createBinary paths deps (CompileBinary n _ o lf) ms - | length ms > 1 = compilerErrorM $ "Multiple matches for main category " ++ show n ++ "." - | length ms == 0 = compilerErrorM $ "Main category " ++ show n ++ " not found." - | otherwise = do - f0 <- if null o - then errorFromIO $ canonicalizePath $ p d show n - else errorFromIO $ canonicalizePath $ p d o - let (CxxOutput _ _ _ ns2 req content) = head ms - -- TODO: Create a helper or a constant or something. - (o',h) <- errorFromIO $ mkstemps "/tmp/zmain_" ".cpp" - errorFromIO $ hPutStr h $ concat $ map (++ "\n") content - errorFromIO $ hClose h - base <- resolveBaseModule resolver - deps2 <- loadPrivateDeps compilerHash f (mapMetadata deps) deps + createBinary paths deps (CompileBinary n _ lm o lf) [CxxOutput _ _ _ ns2 req content] = do + f0 <- if null o + then errorFromIO $ canonicalizePath $ p d show n + else errorFromIO $ canonicalizePath $ p d o + let main = takeFileName f0 ++ ".cpp" + errorFromIO $ hPutStrLn stderr $ "Writing file " ++ main + let mainAbs = getCachedPath (p d) "main" main + writeCachedFile (p d) "main" main $ concat $ map (++ "\n") content + base <- resolveBaseModule resolver + deps2 <- loadPrivateDeps compilerHash f (mapMetadata deps) deps + let paths' = fixPaths $ paths ++ base:(getIncludePathsForDeps deps) + command <- getCommand lm mainAbs f0 deps2 paths' + errorFromIO $ hPutStrLn stderr $ "Creating binary " ++ f0 + f1 <- runCxxCommand backend command + return [f1] where + getCommand LinkStatic mainAbs f0 deps2 paths2 = do let lf' = lf ++ getLinkFlagsForDeps deps2 - let paths' = fixPaths $ paths ++ base:(getIncludePathsForDeps deps) let os = getObjectFilesForDeps deps2 let ofr = getObjectFileResolver os - let os' = ofr ns2 req - let command = CompileToBinary o' os' f0 paths' lf' - errorFromIO $ hPutStrLn stderr $ "Creating binary " ++ f0 - f1 <- runCxxCommand backend command - errorFromIO $ removeFile o' - return [f1] + let objects = ofr ns2 req + return $ CompileToBinary mainAbs objects [] f0 paths2 lf' + getCommand LinkDynamic mainAbs f0 deps2 paths2 = do + let objects = getLibrariesForDeps deps2 + return $ CompileToBinary mainAbs objects [] f0 paths2 [] + createBinary _ _ (CompileBinary n _ _ _ _) [] = + compilerErrorM $ "Main category " ++ show n ++ " not found." + createBinary _ _ (CompileBinary n _ _ _ _) _ = + compilerErrorM $ "Multiple matches for main category " ++ show n ++ "." createBinary _ _ _ _ = return [] - maybeCreateMain cm2 xs2 (CompileBinary n f2 _ _) = + createLibrary _ _ [] [] = return [] + createLibrary name lf deps os = do + let flags = lf ++ getLinkFlagsForDeps deps + -- NOTE: nub is needed because an extension that defines multiple + -- categories will show up more than once in getObjectFiles. + let objects = (nub $ concat $ map getObjectFiles os) ++ getLibrariesForDeps deps + let command = CompileToShared objects name flags + fmap (:[]) $ runCxxCommand backend command + maybeCreateMain cm2 xs2 (CompileBinary n f2 _ _ _) = fmap (:[]) $ compileModuleMain cm2 xs2 n f2 maybeCreateMain _ _ _ = return [] @@ -297,7 +314,7 @@ 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 [] - mapCompilerM (runSingleTest backend cl cm path paths (m:deps2)) ts' where + mapCompilerM (runSingleTest backend cl cm 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." diff --git a/src/Cli/ParseCompileOptions.hs b/src/Cli/ParseCompileOptions.hs --- a/src/Cli/ParseCompileOptions.hs +++ b/src/Cli/ParseCompileOptions.hs @@ -35,26 +35,29 @@ optionHelpText :: [String] optionHelpText = [ "", - "zeolite [options...] -c [path]", - "zeolite [options...] -m [category(.function)] (-o [binary]) [path]", "zeolite [options...] --fast [category(.function)] [.0rx source]", - "zeolite [options...] -r [paths...]", - "zeolite [options...] -R [paths...]", - "zeolite [options...] -t [paths...] (--log-traces [filename])", + "zeolite [options...] -r [modules...]", + "zeolite [options...] -R [modules...]", + "zeolite [options...] -t [modules...] (--log-traces [filename])", "", - "zeolite [options...] --templates [paths...]", + "zeolite [options...] -c [module]", + "zeolite [options...] -m [category(.function)] (-o [binary]) [module]", + "", + "zeolite [options...] --templates [modules...]", "zeolite --get-path", - "zeolite --show-deps [paths...]", + "zeolite --show-deps [modules...]", "zeolite --version", "", - "Normal Modes:", - " -c: Initialize and compile a new library module.", - " -m [category(.function)]: Initialize and compile a new binary module.", - " --fast [category(.function)] [.0rx source]: Create a binary without needing a module.", - " -r: Recompile using the previous compilation options.", - " -R: Recursively recompile using the previous compilation options.", + "Compilation Modes:", + " --fast: Create a binary without needing a config.", + " -r: Recompile using each module's .zeolite-module config.", + " -R: Recursively recompile using each module's .zeolite-module config.", " -t: Only execute tests, without other compilation.", "", + "Configuration Modes:", + " -c: Create a new .zeolite-module config for a libary module.", + " -m: Create a new .zeolite-module config for a binary module.", + "", "Special Modes:", " --templates: Only create C++ templates for undefined categories in .0rp sources.", " --get-path: Show the data path and immediately exit.", @@ -62,16 +65,34 @@ " --version: Show the compiler version and immediately exit.", "", "Options:", - " -f: Force compilation instead of recompiling with -r/-R.", - " -i [path]: A single source path to include as a *public* dependency.", - " -I [path]: A single source path to include as a *private* dependency.", + " -f: Force an operation that zeolite would otherwise reject.", + " -i [module]: A single source module to include as a public dependency.", + " -I [module]: A single source module to include as a private dependency.", " -o [binary]: The name of the binary file to create with -m.", - " -p [path]: Set a path prefix for finding the specified source files.", + " -p [path]: Set a path prefix for finding modules or files.", " --log-traces [filename]: Log call traces to a file when running tests.", "", - "[category]: The name of a concrete category with no params.", - "[function]: The name of a @type function (defaults to \"run\") with no args or params.", - "[path(s...)]: Path(s) containing source or dependency files.", + "Argument Types:", + " category: The name of a concrete category with no params.", + " function: The name of a @type function (defaults to \"run\") with no args or params.", + " module: Path to a directory containing an existing or to-be-created Zeolite module.", + "", + "Examples:", + "", + " # Create a config for a binary in myprogram that calls MyProgram.run() that uses lib/util.", + " zeolite -I lib/util -m MyProgram.run myprogram", + "", + " # Compile a binary that calls MyProgram.run() from myprogram.0rx without a config.", + " zeolite -I lib/util --fast MyProgram.run myprogram.0rx", + "", + " # Create a config for a library in mylibrary that uses lib/util.", + " zeolite -I lib/util -c mylibrary", + "", + " # Recompile myprogram, recursively recompiling its dependencies first.", + " zeolite -R myprogram", + "", + " # Execute the tests from .0rt files in mylibrary.", + " zeolite -t mylibrary", "" ] @@ -131,7 +152,7 @@ (t,fn) <- check $ break (== '.') c checkCategoryName n2 t "-m" checkFunctionName n2 fn "-m" - let m2 = CompileBinary (CategoryName t) (FunctionName fn) "" [] + let m2 = CompileBinary (CategoryName t) (FunctionName fn) LinkDynamic "" [] return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep p m2 f) where check (t,"") = return (t,defaultMainFunc) check (t,'.':fn) = return (t,fn) @@ -160,12 +181,12 @@ update _ = argError n "--log-traces" "Requires an output filename." parseSingle _ ((n,"--log-traces"):_) = argError n "--log-traces" "Set mode to test (-t) first." - parseSingle (CompileOptions h is is2 ds es ep p (CompileBinary t fn o lf) f) ((n,"-o"):os) + parseSingle (CompileOptions h is is2 ds es ep p (CompileBinary t fn lm o lf) f) ((n,"-o"):os) | not $ null o = argError n "-o" "Output name already set." | otherwise = update os where update ((n2,o2):os2) = do checkPathName n2 o2 "-o" - return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep p (CompileBinary t fn o2 lf) f) + return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep p (CompileBinary t fn lm o2 lf) f) update _ = argError n "-o" "Requires an output name." parseSingle _ ((n,"-o"):_) = argError n "-o" "Set mode to binary (-m) first." diff --git a/src/Cli/Programs.hs b/src/Cli/Programs.hs --- a/src/Cli/Programs.hs +++ b/src/Cli/Programs.hs @@ -32,7 +32,7 @@ class CompilerBackend b where - runCxxCommand :: (MonadIO m, ErrorContextM m) => b -> CxxCommand -> m String + runCxxCommand :: (MonadIO m, ErrorContextM m) => b -> CxxCommand -> m FilePath runTestCommand :: (MonadIO m, ErrorContextM m) => b -> TestCommand -> m TestCommandResult getCompilerHash :: b -> VersionHash @@ -43,25 +43,31 @@ data CxxCommand = CompileToObject { - ctoSource :: String, - ctoPath :: String, + ctoSource :: FilePath, + ctoPath :: FilePath, ctoMacros :: [(String,Maybe String)], - ctoPaths :: [String], + ctoPaths :: [FilePath], ctoExtra :: Bool } | + CompileToShared { + ctsSources :: [FilePath], + ctsOutput :: FilePath, + ctsLinkFlags :: [String] + } | CompileToBinary { - ctbMain :: String, - ctbSources :: [String], - ctbOutput :: String, - ctbPaths :: [String], + ctbMain :: FilePath, + ctbSources :: [FilePath], + ctbMacros :: [(String,Maybe String)], + ctbOutput :: FilePath, + ctbPaths :: [FilePath], ctbLinkFlags :: [String] } deriving (Show) data TestCommand = TestCommand { - tcBinary :: String, - tcPath :: String, + tcBinary :: FilePath, + tcPath :: FilePath, tcArgs :: [String] } deriving (Show) diff --git a/src/Cli/RunCompiler.hs b/src/Cli/RunCompiler.hs --- a/src/Cli/RunCompiler.hs +++ b/src/Cli/RunCompiler.hs @@ -42,7 +42,7 @@ runCompiler :: (PathIOHandler r, CompilerBackend b) => r -> b -> CompileOptions -> TrackedErrorsIO () runCompiler resolver backend (CompileOptions _ _ _ ds _ _ p (ExecuteTests tp cl) f) = do base <- resolveBaseModule resolver - ts <- fmap snd $ foldM (preloadTests base) (Map.empty,[]) ds + ts <- fmap snd $ foldM preloadTests (Map.empty,[]) ds checkTestFilters ts cl2 <- prepareCallLog cl allResults <- fmap concat $ mapCompilerM (runModuleTests resolver backend cl2 base tp) ts @@ -57,18 +57,17 @@ prepareCallLog _ = return "" logHeader = ["microseconds","pid","function","context"] compilerHash = getCompilerHash backend - preloadTests base (ca,ms) d = do + preloadTests (ca,ms) d = do m <- loadModuleMetadata compilerHash f ca (p d) let ca2 = ca `Map.union` mapMetadata [m] rm <- loadRecompile (p d) - deps0 <- loadPublicDeps compilerHash f ca2 [base] - let ca3 = ca2 `Map.union` mapMetadata deps0 + let ca3 = ca2 `Map.union` mapMetadata [] deps1 <- loadTestingDeps compilerHash f ca3 m let ca4 = ca3 `Map.union` mapMetadata deps1 - deps2 <- loadPrivateDeps compilerHash f ca4 (deps0++[m]++deps1) + deps2 <- loadPrivateDeps compilerHash f ca4 ([m]++deps1) let ca5 = ca4 `Map.union` mapMetadata deps2 em <- getExprMap (p d) rm - return (ca5,ms ++ [LoadedTests p d m em (deps0++deps1) deps2]) + return (ca5,ms ++ [LoadedTests p d m em (deps1) deps2]) checkTestFilters ts = do let possibleTests = Set.fromList $ concat $ map (cmTestFiles . ltMetadata) ts case Set.toList $ (Set.fromList tp) `Set.difference` possibleTests of @@ -108,60 +107,17 @@ msTestFiles = [], msExtraFiles = [], msExtraPaths = [], - msMode = (CompileBinary c fn (absolute show c) []), + msMode = (CompileBinary c fn LinkStatic (absolute show c) []), msForce = f } compileModule resolver backend spec > return () where - recursive r da (p2,d0) = do - isSystem <- isSystemModule r p2 d0 - if isSystem - then return da - else do - d <- errorFromIO $ canonicalizePath (p2 d0) - rm <- loadRecompile d - if mcPath rm `Set.member` da - then return da - else do - let ds3 = map ((,) d) (mcPublicDeps rm ++ mcPrivateDeps rm) - da' <- foldM (recursive r) (mcPath rm `Set.insert` da) ds3 - runCompiler resolver backend (CompileOptions h [] [] [d] [] [] p CompileRecompile f) - return da' +runCompiler resolver backend (CompileOptions _ _ _ ds _ _ p CompileRecompileRecursive f) = + runRecompileCommon resolver backend f True p ds -runCompiler resolver backend (CompileOptions _ _ _ ds _ _ p CompileRecompile f) = do - mapCompilerM_ recompileSingle ds where - compilerHash = getCompilerHash backend - recompileSingle d0 = do - d <- errorFromIO $ canonicalizePath (p d0) - upToDate <- isPathUpToDate compilerHash f d - if f < ForceAll && upToDate - then compilerWarningM $ "Path " ++ d0 ++ " is up to date" - else do - rm@(ModuleConfig p2 d2 _ is is2 es ep m) <- loadRecompile d - -- In case the module is manually configured with a p such as "..", - -- since the absolute path might not be known ahead of time. - absolute <- errorFromIO $ canonicalizePath (p d0) - let fixed = fixPath (absolute p2) - (ps,xs,ts) <- findSourceFiles fixed d2 - em <- getExprMap (p d0) rm - let spec = ModuleSpec { - msRoot = fixed, - msPath = d2, - msExprMap = em, - msPublicDeps = is, - msPrivateDeps = is2, - msPublicFiles = ps, - msPrivateFiles = xs, - msTestFiles = ts, - msExtraFiles = es, - msExtraPaths = ep, - msMode = m, - msForce = f - } - compileModule resolver backend spec d)) is as2 <- fmap fixPaths $ mapCompilerM (resolveModule resolver (p d)) is2 @@ -208,4 +164,50 @@ mcMode = m } writeRecompile (p d) rm - runCompiler resolver backend (CompileOptions h [] [] [d] [] [] p CompileRecompile DoNotForce) + config <- getRecompilePath (p d) + errorFromIO $ hPutStrLn stderr $ "*** Setup complete. Please edit " ++ config ++ " and recompile with zeolite -r. ***" + +runRecompileCommon :: (PathIOHandler r, CompilerBackend b) => r -> b -> + ForceMode -> Bool -> FilePath -> [FilePath] -> TrackedErrorsIO () +runRecompileCommon resolver backend f rec p ds = do + explicit <- fmap Set.fromList $ mapCompilerM (errorFromIO . canonicalizePath . (p )) ds + foldM (recursive resolver explicit) Set.empty (map ((,) p) ds) >> return () where + compilerHash = getCompilerHash backend + recursive r explicit da (p2,d0) = do + d <- resolveModule r p2 d0 + isSystem <- isSystemModule r p2 d0 + let process = if rec + then d `Set.member` explicit || not isSystem + else d `Set.member` explicit + if not process || d `Set.member` da + then return da + else do + rm <- loadRecompile d + let ds3 = map ((,) d) (mcPublicDeps rm ++ mcPrivateDeps rm) + da' <- foldM (recursive r explicit) (d `Set.insert` da) ds3 + recompile d + return da' + recompile d = do + upToDate <- isPathUpToDate compilerHash f d + if f < ForceAll && upToDate + then compilerWarningM $ "Path " ++ d ++ " is up to date" + else do + rm@(ModuleConfig p2 d2 _ is is2 es ep m) <- loadRecompile d + let fixed = fixPath (d p2) + (ps,xs,ts) <- findSourceFiles fixed d2 + em <- getExprMap d rm + let spec = ModuleSpec { + msRoot = fixed, + msPath = d2, + msExprMap = em, + msPublicDeps = is, + msPrivateDeps = is2, + msPublicFiles = ps, + msPrivateFiles = xs, + msTestFiles = ts, + msExtraFiles = es, + msExtraPaths = ep, + msMode = m, + msForce = f + } + compileModule resolver backend spec b -> FilePath -> - LanguageModule SourceContext -> FilePath -> [FilePath] -> [CompileMetadata] -> + LanguageModule SourceContext -> [FilePath] -> [CompileMetadata] -> (String,String) -> TrackedErrorsIO ((Int,Int),TrackedErrors ()) -runSingleTest b cl cm p paths deps (f,s) = do +runSingleTest b cl cm paths deps (f,s) = do errorFromIO $ hPutStrLn stderr $ "\nExecuting tests from " ++ f allResults <- checkAndRun (parseTestSource (f,s)) return $ second (("\nIn test file " ++ f) ??>) allResults where @@ -70,8 +70,12 @@ let name = "\"" ++ ithTestName (itHeader t) ++ "\" (from " ++ f ++ ")" let context = formatFullContextBrace (ithContext $ itHeader t) let scope = "\nIn testcase \"" ++ ithTestName (itHeader t) ++ "\"" ++ context + warnUnused (itHeader t) (result >> return ())) else do @@ -84,8 +88,27 @@ else errorFromIO $ hPutStrLn stderr $ "*** All tests in testcase " ++ name ++ " passed ***" return ((passed,failed),combined) - run (ExpectCompilerError _ rs es) args cs ds ts = do - let result = compileAll args cs ds ts + warnUnused (IntegrationTestHeader _ _ args timeout ex) = check where + check = + case ex of + (ExpectCompilerError _ _ _) -> do + warnArgs "error" + warnTimeout "error" + (ExpectCompiles _ _ _) -> do + warnArgs "compiles" + warnTimeout "compiles" + _ -> return () + warnArgs ex2 = + case args of + [] -> return () + _ -> compilerWarningM $ "Explicit args are ignored in " ++ ex2 ++ " tests: " ++ intercalate ", " (map show args) + warnTimeout ex2 = + case timeout of + Nothing -> return () + Just t -> compilerWarningM $ "Explicit timeouts are ignored in " ++ ex2 ++ " tests: " ++ show t + + run (ExpectCompilerError _ rs es) _ _ cs ds ts = do + result <- toTrackedErrors $ compileAll [] cs ds ts if not $ isCompilerError result then compilerErrorM "Expected compilation failure" else fmap (:[]) $ return $ do @@ -93,23 +116,23 @@ let errors = show $ getCompilerError result checkContent rs es (lines warnings ++ lines errors) [] [] - run (ExpectCompiles _ rs es) args cs ds ts = do - let result = compileAll args cs ds ts + run (ExpectCompiles _ rs es) _ _ cs ds ts = do + result <- toTrackedErrors $ compileAll [] cs ds ts if isCompilerError result then fromTrackedErrors result >> return [] else fmap (:[]) $ return $ do let warnings = show $ getCompilerWarnings result checkContent rs es (lines warnings) [] [] - run (ExpectRuntimeError _ rs es) args cs ds ts = do + run (ExpectRuntimeError _ rs es) args timeout cs ds ts = do when (length ts /= 1) $ compilerErrorM "Exactly one unittest is required when crash is expected" uniqueTestNames ts - execute False rs es args cs ds ts + execute False rs es args timeout cs ds ts - run (ExpectRuntimeSuccess _ rs es) args cs ds ts = do + run (ExpectRuntimeSuccess _ rs es) args timeout cs ds ts = do when (null ts) $ compilerErrorM "At least one unittest is required when success is expected" uniqueTestNames ts - execute True rs es args cs ds ts + execute True rs es args timeout cs ds ts checkContent rs es comp err out = do let cr = checkRequired rs comp err out @@ -134,13 +157,13 @@ testClash (n,ts) = "unittest " ++ show n ++ " is defined multiple times" !!> (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 + execute s2 rs es args timeout cs ds ts = do + result <- toTrackedErrors $ compileAll args cs ds ts if isCompilerError result then return [result >> return ()] else do let (xx,main,fs) = getCompilerSuccess result - (dir,binaryName) <- createBinary main xx + (dir,binaryName) <- createBinary main timeout xx results <- liftIO $ sequence $ map (toTrackedErrors . executeTest binaryName rs es result s2) fs when (not $ any isCompilerError results) $ errorFromIO $ removeDirectoryRecursive dir return results @@ -153,21 +176,19 @@ case (s2,s2') of (True,False) -> collectAllM_ $ (asCompilerError res):(map compilerErrorM $ err ++ out) (False,True) -> collectAllM_ [compilerErrorM "Expected runtime failure", - asCompilerError res fromTrackedErrors $ checkContent rs es (lines $ show $ getCompilerWarnings res) err out where context = "\nIn unittest " ++ show f2 ++ formatFullContextBrace c - printOutcome outcome = do - failed <- isCompilerErrorM outcome - if failed - then errorFromIO $ hPutStrLn stderr $ "--- unittest " ++ show f2 ++ " failed ---" - else errorFromIO $ hPutStrLn stderr $ "--- unittest " ++ show f2 ++ " passed ---" - outcome + printOutcome outcome = + ifElseSuccessT outcome + (hPutStrLn stderr $ "--- unittest " ++ show f2 ++ " passed ---") + (hPutStrLn stderr $ "--- unittest " ++ show f2 ++ " failed ---") compileAll args cs ds ts = do let ns1 = StaticNamespace $ privateNamespace s let cs' = map (setCategoryNamespace ns1) cs - compileTestsModule cm ns1 args cs' ds ts + fromTrackedErrors $ compileTestsModule cm ns1 args cs' ds ts checkRequired rs comp err out = mapCompilerM_ (checkSubsetForRegex True comp err out) rs checkExcluded es comp err out = mapCompilerM_ (checkSubsetForRegex False comp err out) es @@ -184,23 +205,25 @@ let found = any (=~ r) ms when (found && not expected) $ compilerErrorM $ "Pattern \"" ++ r ++ "\" present in " ++ n when (not found && expected) $ compilerErrorM $ "Pattern \"" ++ r ++ "\" missing from " ++ n - createBinary (CxxOutput _ f2 _ ns req content) xx = do + createBinary (CxxOutput _ f2 _ _ _ content) timeout xx = do dir <- errorFromIO $ mkdtemp "/tmp/ztest_" errorFromIO $ hPutStrLn stderr $ "Writing temporary files to " ++ dir sources <- mapCompilerM (writeSingleFile dir) xx - -- TODO: Cache CompileMetadata here for debugging failures. - let sources' = resolveObjectDeps deps p dir sources let main = dir f2 let binary = dir "testcase" errorFromIO $ writeFile main $ concat $ map (++ "\n") content let flags = getLinkFlagsForDeps deps let paths' = nub $ map fixPath (dir:paths) - let os = getObjectFilesForDeps deps - let ofr = getObjectFileResolver (sources' ++ os) - let os' = ofr ns req - let command = CompileToBinary main os' binary paths' flags + let libraries = getLibrariesForDeps deps + macro <- timeoutMacro timeout + let command = CompileToBinary main (concat (map fst sources) ++ libraries) macro binary paths' flags file <- runCxxCommand b command return (dir,file) + timeoutMacro (Just 0) = return [] -- No timeout. + timeoutMacro Nothing = return [(testTimeoutMacro,Just "30")] -- Default timeout. + timeoutMacro (Just t) + | t < 0 || t > 65535 = compilerErrorM $ "Invalid testcase timeout " ++ show t ++ " => use timeout 0 for unlimited time" + | otherwise = return [(testTimeoutMacro,Just (show t))] -- Custom timeout. writeSingleFile d ca@(CxxOutput _ f2 _ _ _ content) = do errorFromIO $ writeFile (d f2) $ concat $ map (++ "\n") content if isSuffixOf ".cpp" f2 diff --git a/src/CompilerCxx/Code.hs b/src/CompilerCxx/Code.hs --- a/src/CompilerCxx/Code.hs +++ b/src/CompilerCxx/Code.hs @@ -27,7 +27,9 @@ escapeChars, expressionFromLiteral, functionLabelType, + hasPrimitiveValue, indentCompiled, + integratedCategoryDeps, isStoredUnboxed, newFunctionLabel, noTestsOnlySourceGuard, @@ -119,6 +121,16 @@ showCreationTrace :: String showCreationTrace = "TRACE_CREATION" +hasPrimitiveValue :: CategoryName -> Bool +hasPrimitiveValue BuiltinBool = True +hasPrimitiveValue BuiltinInt = True +hasPrimitiveValue BuiltinFloat = True +hasPrimitiveValue BuiltinChar = True +hasPrimitiveValue _ = False + +integratedCategoryDeps :: Set.Set CategoryName +integratedCategoryDeps = Set.fromList [BuiltinBool,BuiltinInt,BuiltinFloat,BuiltinChar] + isStoredUnboxed :: ValueType -> Bool isStoredUnboxed t | t == boolRequiredValue = True @@ -156,7 +168,7 @@ useAsWhatever (LazySingle e) = useAsWhatever $ getFromLazy e useAsReturns :: ExpressionValue -> String -useAsReturns (OpaqueMulti e) = "(" ++ e ++ ")" +useAsReturns (OpaqueMulti e) = e useAsReturns (WrappedSingle e) = "ReturnTuple(" ++ e ++ ")" useAsReturns (UnwrappedSingle e) = "ReturnTuple(" ++ e ++ ")" useAsReturns (BoxedPrimitive PrimBool e) = "ReturnTuple(Box_Bool(" ++ e ++ "))" @@ -172,7 +184,7 @@ useAsReturns (LazySingle e) = useAsReturns $ getFromLazy e useAsArgs :: ExpressionValue -> String -useAsArgs (OpaqueMulti e) = "(" ++ e ++ ")" +useAsArgs (OpaqueMulti e) = e useAsArgs (WrappedSingle e) = "ArgTuple(" ++ e ++ ")" useAsArgs (UnwrappedSingle e) = "ArgTuple(" ++ e ++ ")" useAsArgs (BoxedPrimitive PrimBool e) = "ArgTuple(Box_Bool(" ++ e ++ "))" @@ -189,8 +201,8 @@ useAsUnwrapped :: ExpressionValue -> String useAsUnwrapped (OpaqueMulti e) = "(" ++ e ++ ").Only()" -useAsUnwrapped (WrappedSingle e) = "(" ++ e ++ ")" -useAsUnwrapped (UnwrappedSingle e) = "(" ++ e ++ ")" +useAsUnwrapped (WrappedSingle e) = e +useAsUnwrapped (UnwrappedSingle e) = e useAsUnwrapped (BoxedPrimitive PrimBool e) = "Box_Bool(" ++ e ++ ")" useAsUnwrapped (BoxedPrimitive PrimString e) = "Box_String(" ++ e ++ ")" useAsUnwrapped (BoxedPrimitive PrimChar e) = "Box_Char(" ++ e ++ ")" @@ -204,23 +216,23 @@ useAsUnwrapped (LazySingle e) = useAsUnwrapped $ getFromLazy e useAsUnboxed :: PrimitiveType -> ExpressionValue -> String -useAsUnboxed PrimBool (OpaqueMulti e) = "(" ++ e ++ ").Only()->AsBool()" -useAsUnboxed PrimString (OpaqueMulti e) = "(" ++ e ++ ").Only()->AsString()" -useAsUnboxed PrimChar (OpaqueMulti e) = "(" ++ e ++ ").Only()->AsChar()" -useAsUnboxed PrimInt (OpaqueMulti e) = "(" ++ e ++ ").Only()->AsInt()" -useAsUnboxed PrimFloat (OpaqueMulti e) = "(" ++ e ++ ").Only()->AsFloat()" -useAsUnboxed PrimBool (WrappedSingle e) = "(" ++ e ++ ")->AsBool()" -useAsUnboxed PrimString (WrappedSingle e) = "(" ++ e ++ ")->AsString()" -useAsUnboxed PrimChar (WrappedSingle e) = "(" ++ e ++ ")->AsChar()" -useAsUnboxed PrimInt (WrappedSingle e) = "(" ++ e ++ ")->AsInt()" -useAsUnboxed PrimFloat (WrappedSingle e) = "(" ++ e ++ ")->AsFloat()" -useAsUnboxed PrimBool (UnwrappedSingle e) = "(" ++ e ++ ")->AsBool()" -useAsUnboxed PrimString (UnwrappedSingle e) = "(" ++ e ++ ")->AsString()" -useAsUnboxed PrimChar (UnwrappedSingle e) = "(" ++ e ++ ")->AsChar()" -useAsUnboxed PrimInt (UnwrappedSingle e) = "(" ++ e ++ ")->AsInt()" -useAsUnboxed PrimFloat (UnwrappedSingle e) = "(" ++ e ++ ")->AsFloat()" -useAsUnboxed _ (BoxedPrimitive _ e) = "(" ++ e ++ ")" -useAsUnboxed _ (UnboxedPrimitive _ e) = "(" ++ e ++ ")" +useAsUnboxed PrimBool (OpaqueMulti e) = "(" ++ e ++ ").Only().AsBool()" +useAsUnboxed PrimString (OpaqueMulti e) = "(" ++ e ++ ").Only().AsString()" +useAsUnboxed PrimChar (OpaqueMulti e) = "(" ++ e ++ ").Only().AsChar()" +useAsUnboxed PrimInt (OpaqueMulti e) = "(" ++ e ++ ").Only().AsInt()" +useAsUnboxed PrimFloat (OpaqueMulti e) = "(" ++ e ++ ").Only().AsFloat()" +useAsUnboxed PrimBool (WrappedSingle e) = "(" ++ e ++ ").AsBool()" +useAsUnboxed PrimString (WrappedSingle e) = "(" ++ e ++ ").AsString()" +useAsUnboxed PrimChar (WrappedSingle e) = "(" ++ e ++ ").AsChar()" +useAsUnboxed PrimInt (WrappedSingle e) = "(" ++ e ++ ").AsInt()" +useAsUnboxed PrimFloat (WrappedSingle e) = "(" ++ e ++ ").AsFloat()" +useAsUnboxed PrimBool (UnwrappedSingle e) = "(" ++ e ++ ").AsBool()" +useAsUnboxed PrimString (UnwrappedSingle e) = "(" ++ e ++ ").AsString()" +useAsUnboxed PrimChar (UnwrappedSingle e) = "(" ++ e ++ ").AsChar()" +useAsUnboxed PrimInt (UnwrappedSingle e) = "(" ++ e ++ ").AsInt()" +useAsUnboxed PrimFloat (UnwrappedSingle e) = "(" ++ e ++ ").AsFloat()" +useAsUnboxed _ (BoxedPrimitive _ e) = e +useAsUnboxed _ (UnboxedPrimitive _ e) = e useAsUnboxed t (LazySingle e) = useAsUnboxed t $ getFromLazy e valueAsWrapped :: ExpressionValue -> ExpressionValue @@ -251,8 +263,8 @@ | t == intRequiredValue = "PrimInt" | t == floatRequiredValue = "PrimFloat" | t == charRequiredValue = "PrimChar" - | isWeakValue t = "W" - | otherwise = "S" + | isWeakValue t = "WeakValue" + | otherwise = "BoxedValue" variableLazyType :: ValueType -> String variableLazyType t = "LazyInit<" ++ variableStoredType t ++ ">" @@ -263,8 +275,8 @@ | t == intRequiredValue = "PrimInt" | t == floatRequiredValue = "PrimFloat" | t == charRequiredValue = "PrimChar" - | isWeakValue t = "W&" - | otherwise = "S&" + | isWeakValue t = "WeakValue&" + | otherwise = "BoxedValue&" readStoredVariable :: Bool -> ValueType -> String -> ExpressionValue readStoredVariable True t s = LazySingle $ readStoredVariable False t s diff --git a/src/CompilerCxx/CxxFiles.hs b/src/CompilerCxx/CxxFiles.hs --- a/src/CompilerCxx/CxxFiles.hs +++ b/src/CompilerCxx/CxxFiles.hs @@ -196,10 +196,13 @@ common (StreamlinedExtension t ns) = sequence [streamlinedHeader,streamlinedSource] where streamlinedHeader = do let filename = headerStreamlined (getCategoryName t) - (CompiledData req out) <- fmap (addNamespace t) $ concatM [ + let maybeValue = if hasPrimitiveValue (getCategoryName t) + then [] + else [defineAbstractValue t] + (CompiledData req out) <- fmap (addNamespace t) $ concatM $ [ defineAbstractCategory t, - defineAbstractType t, - defineAbstractValue t, + defineAbstractType t + ] ++ maybeValue ++ [ declareAbstractGetters t ] return $ CxxOutput (Just $ getCategoryName t) @@ -207,18 +210,21 @@ (getCategoryNamespace t) (getCategoryNamespace t `Set.insert` ns) req - (headerGuard (getCategoryName t) $ allowTestsOnly $ addSourceIncludes $ addCategoryHeader t $ addIncludes req out) + (headerGuard (getCategoryName t) $ allowTestsOnly $ addTemplateIncludes $ addCategoryHeader t $ addIncludes req out) streamlinedSource = do let filename = sourceStreamlined (getCategoryName t) let (cf,tf,vf) = partitionByScope sfScope $ getCategoryFunctions t - (CompiledData req out) <- fmap (addNamespace t) $ concatM [ + let maybeValue = if hasPrimitiveValue (getCategoryName t) + then [] + else [defineValueOverrides t (getCategoryFunctions t)] + (CompiledData req out) <- fmap (addNamespace t) $ concatM $ [ defineFunctions t cf tf vf, defineCategoryOverrides t (getCategoryFunctions t), - defineTypeOverrides t (getCategoryFunctions t), - defineValueOverrides t (getCategoryFunctions t), + defineTypeOverrides t (getCategoryFunctions t) + ] ++ maybeValue ++ [ defineExternalGetters t ] - let req' = Set.unions [req,getCategoryMentions t,defaultCategoryDeps] + let req' = Set.unions [req,getCategoryMentions t,integratedCategoryDeps] return $ CxxOutput (Just $ getCategoryName t) filename (getCategoryNamespace t) @@ -228,14 +234,22 @@ common (StreamlinedTemplate t tm) = fmap (:[]) streamlinedTemplate where streamlinedTemplate = do [cp,tp,vp] <- getProcedureScopes tm Map.empty defined - (CompiledData req out) <- fmap (addNamespace t) $ concatM [ - declareCustomValueGetter t, + let maybeGetter = if hasPrimitiveValue (getCategoryName t) + then [] + else [declareCustomValueGetter t] + let maybeGetter2 = if hasPrimitiveValue (getCategoryName t) + then [] + else [defineCustomValueGetter t] + let maybeValue = if hasPrimitiveValue (getCategoryName t) + then [] + else [defineCustomValue t vp] + (CompiledData req out) <- fmap (addNamespace t) $ concatM $ + maybeGetter ++ [ defineCustomCategory t cp, - defineCustomType t tp, - defineCustomValue t vp, - defineCustomGetters t, - defineCustomValueGetter t - ] + defineCustomType t tp + ] ++ maybeValue ++ [ + defineCustomGetters t + ] ++ maybeGetter2 let req' = Set.unions [req,getCategoryMentions t] return $ CxxOutput (Just $ getCategoryName t) filename @@ -297,7 +311,7 @@ defineInternalGetters t, defineExternalGetters t ] - let req' = req `Set.union` getCategoryMentions t + let req' = Set.unions [req,getCategoryMentions t,integratedCategoryDeps] return $ CxxOutput (Just $ getCategoryName t) filename (getCategoryNamespace t) @@ -485,7 +499,7 @@ ] declareValueOverrides = onlyCodes [ " std::string CategoryName() const final;", - " ReturnTuple Dispatch(const S& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) final;" + " ReturnTuple Dispatch(const BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) final;" ] defineCategoryOverrides t fs = return $ mconcat [ @@ -515,7 +529,7 @@ params = map vpParam $ getCategoryParams t defineValueOverrides t fs = return $ mconcat [ onlyCode $ "std::string " ++ className ++ "::CategoryName() const { return parent->CategoryName(); }", - onlyCode $ "ReturnTuple " ++ className ++ "::Dispatch(const S& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) {", + onlyCode $ "ReturnTuple " ++ className ++ "::Dispatch(const BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) {", createFunctionDispatch (getCategoryName t) ValueScope fs, onlyCode $ "}" ] where @@ -653,7 +667,9 @@ 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 <> callLog <> sel) + let contentTop = mconcat [timeoutInclude,onlyCodes include,ts'] + let contentMain = mconcat [setTimeout,argv,callLog,sel] + let file = testsOnlySourceGuard ++ createMainCommon "testcase" contentTop contentMain return $ CompiledData req file where args' = map escapeChars args argv = onlyCodes [ @@ -661,6 +677,16 @@ "ProgramArgv program_argv(sizeof argv2 / sizeof(char*), argv2);" ] callLog = onlyCode "LogCallsToFile call_logger_((argc < 3)? \"\" : argv[2]);" + timeoutInclude = onlyCodes [ + "#ifdef " ++ testTimeoutMacro, + "#include ", + "#endif // " ++ testTimeoutMacro + ] + setTimeout = onlyCodes [ + "#ifdef " ++ testTimeoutMacro, + "alarm(" ++ testTimeoutMacro ++ ");", + "#endif // " ++ testTimeoutMacro + ] addNamespace :: AnyCategory c -> CompiledData [String] -> CompiledData [String] addNamespace t cs @@ -711,7 +737,7 @@ | s == TypeScope = " using CallType = ReturnTuple(" ++ typeName n ++ "::*)(const S&, const ParamTuple&, const ValueTuple&);" | s == ValueScope = " using CallType = ReturnTuple(" ++ valueName n ++ - "::*)(const S&, const ParamTuple&, const ValueTuple&);" + "::*)(const BoxedValue&, const ParamTuple&, const ValueTuple&);" | otherwise = undefined name f | s == CategoryScope = categoryName n ++ "::" ++ callName f @@ -897,7 +923,7 @@ declareInternalValue :: AnyCategory c -> CompiledData [String] declareInternalValue t = onlyCodes [ - "S " ++ valueCreator (getCategoryName t) ++ + "BoxedValue " ++ valueCreator (getCategoryName t) ++ "(S<" ++ typeName (getCategoryName t) ++ "> parent, " ++ "const ValueTuple& args);" ] @@ -908,9 +934,9 @@ defineInternalValue2 :: String -> AnyCategory c -> CompiledData [String] defineInternalValue2 className t = onlyCodes [ - "S " ++ valueCreator (getCategoryName t) ++ "(S<" ++ typeName (getCategoryName t) ++ "> parent, " ++ + "BoxedValue " ++ valueCreator (getCategoryName t) ++ "(S<" ++ typeName (getCategoryName t) ++ "> parent, " ++ "const ValueTuple& args) {", - " return S_get(new " ++ className ++ "(parent, args));", + " return BoxedValue(new " ++ className ++ "(parent, args));", "}" ] diff --git a/src/CompilerCxx/Naming.hs b/src/CompilerCxx/Naming.hs --- a/src/CompilerCxx/Naming.hs +++ b/src/CompilerCxx/Naming.hs @@ -51,6 +51,7 @@ templateStreamlined, testFilename, testFunctionName, + testTimeoutMacro, typeCreator, typeCustom, typeGetter, @@ -191,6 +192,9 @@ | isStaticNamespace $ getCategoryNamespace t = show (getCategoryNamespace t) ++ "::" ++ (typeGetter $ getCategoryName t) | otherwise = typeGetter $ getCategoryName t + +testTimeoutMacro :: String +testTimeoutMacro = "ZEOLITE_TEST_TIMEOUT" publicNamespaceMacro :: String publicNamespaceMacro = "ZEOLITE_PUBLIC_NAMESPACE" diff --git a/src/CompilerCxx/Procedure.hs b/src/CompilerCxx/Procedure.hs --- a/src/CompilerCxx/Procedure.hs +++ b/src/CompilerCxx/Procedure.hs @@ -76,7 +76,7 @@ "(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)" + "(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args)" | otherwise = undefined data CxxFunctionType = @@ -134,7 +134,7 @@ "(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)" ++ final ++ " {" + "(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args)" ++ final ++ " {" | otherwise = undefined returnType = "ReturnTuple" setProcedureTrace @@ -171,7 +171,7 @@ noTrace <- csGetNoTrace if noTrace then return (e',ctx') - else return (predTraceContext c ++ e',ctx') + else return (predTraceContext c ++ "(" ++ e' ++ ")",ctx') where compile = "In condition at " ++ formatFullContext c ??> do (ts,e') <- compileExpression e @@ -535,37 +535,7 @@ CompilerContext c m [String] a) => Expression c -> CompilerState a m (ExpressionType,ExpressionValue) compileExpression = compile where - compile (Literal (StringLiteral _ l)) = do - csAddRequired (Set.fromList [BuiltinString]) - return $ expressionFromLiteral PrimString (escapeChars l) - compile (Literal (CharLiteral _ l)) = do - csAddRequired (Set.fromList [BuiltinChar]) - return $ expressionFromLiteral PrimChar ("'" ++ escapeChar l ++ "'") - compile (Literal (IntegerLiteral c True l)) = do - csAddRequired (Set.fromList [BuiltinInt]) - when (l > 2^(64 :: Integer) - 1) $ compilerErrorM $ - "Literal " ++ show l ++ formatFullContextBrace c ++ " is greater than the max value for 64-bit unsigned" - let l' = if l > 2^(63 :: Integer) - 1 then l - 2^(64 :: Integer) else l - return $ expressionFromLiteral PrimInt (show l') - compile (Literal (IntegerLiteral c False l)) = do - csAddRequired (Set.fromList [BuiltinInt]) - when (l > 2^(63 :: Integer) - 1) $ compilerErrorM $ - "Literal " ++ show l ++ formatFullContextBrace c ++ " is greater than the max value for 64-bit signed" - when ((-l) > (2^(63 :: Integer) - 2)) $ compilerErrorM $ - "Literal " ++ show l ++ formatFullContextBrace c ++ " is less than the min value for 64-bit signed" - return $ expressionFromLiteral PrimInt (show l) - compile (Literal (DecimalLiteral _ l e)) = do - csAddRequired (Set.fromList [BuiltinFloat]) - -- TODO: Check bounds. - return $ expressionFromLiteral PrimFloat (show l ++ "E" ++ show e) - compile (Literal (BoolLiteral _ True)) = do - csAddRequired (Set.fromList [BuiltinBool]) - return $ expressionFromLiteral PrimBool "true" - compile (Literal (BoolLiteral _ False)) = do - csAddRequired (Set.fromList [BuiltinBool]) - return $ expressionFromLiteral PrimBool "false" - compile (Literal (EmptyLiteral _)) = do - return (Positional [emptyType],UnwrappedSingle "Var_empty") + compile (Literal l) = compileValueLiteral l compile (Expression _ s os) = do foldl transform (compileExpressionStart s) os compile (UnaryExpression c (FunctionOperator _ (FunctionSpec _ (CategoryFunction c2 cn) fn ps)) e) = @@ -590,60 +560,24 @@ | o == "-" = doNeg t e2 | o == "~" = doComp t e2 | otherwise = compilerErrorM $ "Unknown unary operator \"" ++ o ++ "\" " ++ - formatFullContextBrace c + formatFullContextBrace c doNot t e2 = do when (t /= boolRequiredValue) $ compilerErrorM $ "Cannot use " ++ show t ++ " with unary ! operator" ++ - formatFullContextBrace c - return $ (Positional [boolRequiredValue],UnboxedPrimitive PrimBool $ "!" ++ useAsUnboxed PrimBool e2) + formatFullContextBrace c + return $ (Positional [boolRequiredValue],UnboxedPrimitive PrimBool $ "!(" ++ useAsUnboxed PrimBool e2 ++ ")") doNeg t e2 | t == intRequiredValue = return $ (Positional [intRequiredValue], UnboxedPrimitive PrimInt $ "-" ++ useAsUnboxed PrimInt e2) | t == floatRequiredValue = return $ (Positional [floatRequiredValue], - UnboxedPrimitive PrimFloat $ "-" ++ useAsUnboxed PrimFloat e2) + UnboxedPrimitive PrimFloat $ "-(" ++ useAsUnboxed PrimFloat e2 ++ ")") | otherwise = compilerErrorM $ "Cannot use " ++ show t ++ " with unary - operator" ++ - formatFullContextBrace c + formatFullContextBrace c doComp t e2 | t == intRequiredValue = return $ (Positional [intRequiredValue], - UnboxedPrimitive PrimInt $ "~" ++ useAsUnboxed PrimInt e2) + UnboxedPrimitive PrimInt $ "~(" ++ useAsUnboxed PrimInt e2 ++ ")") | otherwise = compilerErrorM $ "Cannot use " ++ show t ++ " with unary ~ operator" ++ - formatFullContextBrace c - compile (InitializeValue c t es) = do - scope <- csCurrentScope - t' <- case scope of - CategoryScope -> case t of - Nothing -> compilerErrorM $ "Param " ++ show ParamSelf ++ " not found" - Just t0 -> return t0 - _ -> do - self <- csSelfType - case t of - Just t0 -> lift $ replaceSelfSingle (singleType $ JustTypeInstance self) t0 - Nothing -> return self - es' <- sequence $ map compileExpression $ pValues es - (ts,es'') <- lift $ getValues es' - csCheckValueInit c t' (Positional ts) - params <- expandParams $ tiParams t' - sameType <- csSameType t' - s <- csCurrentScope - let typeInstance = getType t' sameType s params - -- TODO: This is unsafe if used in a type or category constructor. - return (Positional [ValueType RequiredValue $ singleType $ JustTypeInstance t'], - UnwrappedSingle $ valueCreator (tiName t') ++ "(" ++ typeInstance ++ ", " ++ es'' ++ ")") - where - getType _ True ValueScope _ = "parent" - getType _ True TypeScope _ = "shared_from_this()" - getType t2 _ _ params = typeCreator (tiName t2) ++ "(" ++ params ++ ")" - -- Single expression, but possibly multi-return. - getValues [(Positional ts,e)] = return (ts,useAsArgs e) - -- Multi-expression => must all be singles. - getValues rs = do - (mapCompilerM_ checkArity $ zip ([0..] :: [Int]) $ map fst rs) case t of + Nothing -> compilerErrorM $ "Param " ++ show ParamSelf ++ " not found" + Just t0 -> return t0 + _ -> do + self <- csSelfType + case t of + Just t0 -> lift $ replaceSelfSingle (singleType $ JustTypeInstance self) t0 + Nothing -> return self + es' <- sequence $ map compileExpression $ pValues es + (ts,es'') <- lift $ getValues es' + csCheckValueInit c t' (Positional ts) + params <- expandParams $ tiParams t' + sameType <- csSameType t' + s <- csCurrentScope + let typeInstance = getType t' sameType s params + -- TODO: This is unsafe if used in a type or category constructor. + return (Positional [ValueType RequiredValue $ singleType $ JustTypeInstance t'], + UnwrappedSingle $ valueCreator (tiName t') ++ "(" ++ typeInstance ++ ", " ++ es'' ++ ")") + where + getType _ True ValueScope _ = "parent" + getType _ True TypeScope _ = "shared_from_this()" + getType t2 _ _ params = typeCreator (tiName t2) ++ "(" ++ params ++ ")" + -- Single expression, but possibly multi-return. + getValues [(Positional ts,e)] = return (ts,useAsArgs e) + -- Multi-expression => must all be singles. + getValues rs = do + (mapCompilerM_ checkArity $ zip ([0..] :: [Int]) $ map fst rs) + ValueLiteral c -> CompilerState a m (ExpressionType,ExpressionValue) +compileValueLiteral (StringLiteral _ l) = do + csAddRequired (Set.fromList [BuiltinString]) + return $ expressionFromLiteral PrimString (escapeChars l) +compileValueLiteral (CharLiteral _ l) = do + csAddRequired (Set.fromList [BuiltinChar]) + return $ expressionFromLiteral PrimChar ("'" ++ escapeChar l ++ "'") +compileValueLiteral (IntegerLiteral c True l) = do + csAddRequired (Set.fromList [BuiltinInt]) + when (l > 2^(64 :: Integer) - 1) $ compilerErrorM $ + "Literal " ++ show l ++ formatFullContextBrace c ++ " is greater than the max value for 64-bit unsigned" + return $ expressionFromLiteral PrimInt (show l ++ "ULL") +compileValueLiteral (IntegerLiteral c False l) = do + csAddRequired (Set.fromList [BuiltinInt]) + when (l > 2^(63 :: Integer) - 1) $ compilerErrorM $ + "Literal " ++ show l ++ formatFullContextBrace c ++ " is greater than the max value for 64-bit signed" + when ((-l) > 2^(63 :: Integer)) $ compilerErrorM $ + "Literal " ++ show l ++ formatFullContextBrace c ++ " is less than the min value for 64-bit signed" + -- NOTE: clang++ processes -abcLL as -(abcLL), which means that -(2^63) + -- written out as a literal looks like an unsigned overflow. Using ULL here + -- silences that warning. + return $ expressionFromLiteral PrimInt (show l ++ "ULL") +compileValueLiteral (DecimalLiteral _ l e) = do + csAddRequired (Set.fromList [BuiltinFloat]) + -- TODO: Check bounds. + return $ expressionFromLiteral PrimFloat (show l ++ "E" ++ show e) +compileValueLiteral (BoolLiteral _ True) = do + csAddRequired (Set.fromList [BuiltinBool]) + return $ expressionFromLiteral PrimBool "true" +compileValueLiteral (BoolLiteral _ False) = do + csAddRequired (Set.fromList [BuiltinBool]) + return $ expressionFromLiteral PrimBool "false" +compileValueLiteral (EmptyLiteral _) = do + return (Positional [emptyType],UnwrappedSingle "Var_empty") + disallowInferred :: (Ord c, Show c, CollectErrorsM m) => Positional (InstanceOrInferred c) -> m [GeneralInstance] disallowInferred = mapCompilerM disallow . pValues where disallow (AssignedInstance _ t) = return t @@ -974,7 +982,7 @@ pa <- fmap Map.fromList $ processPairs toInstance (fmap vpParam $ sfParams f) ps gs <- inferParamTypes r fa pa args gs' <- mergeInferredTypes r fa fm pa gs - let pa3 = guessesAsParams gs' `Map.union` pa + let pa3 = gs' `Map.union` pa fmap Positional $ mapCompilerM (subPosition pa3) (pValues $ sfParams f) where subPosition pa2 p = case (vpParam p) `Map.lookup` pa2 of @@ -992,7 +1000,7 @@ pa <- fmap Map.fromList $ processPairs toInstance params ps gs <- inferParamTypes r fa pa args' gs' <- mergeInferredTypes r fa (Map.fromList $ zip (pValues params) (repeat [])) pa gs - let pa3 = guessesAsParams gs' `Map.union` pa + let pa3 = gs' `Map.union` pa fmap Positional $ mapCompilerM (subPosition pa3) (pValues params) where subPosition pa2 p = case p `Map.lookup` pa2 of diff --git a/src/Config/LocalConfig.hs b/src/Config/LocalConfig.hs --- a/src/Config/LocalConfig.hs +++ b/src/Config/LocalConfig.hs @@ -51,7 +51,9 @@ data Backend = UnixBackend { ucCxxBinary :: FilePath, - ucCxxOptions :: [String], + ucCompileFlags :: [String], + ucLibraryFlags :: [String], + ucBinaryFlags :: [String], ucArBinary :: FilePath } deriving (Read,Show) @@ -77,28 +79,36 @@ compilerVersion = showVersion version instance CompilerBackend Backend where - runCxxCommand (UnixBackend cb co ab) (CompileToObject s p ms ps e) = do - objName <- errorFromIO $ canonicalizePath $ p (takeFileName $ dropExtension s ++ ".o") - executeProcess cb (co ++ otherOptions ++ ["-c", s, "-o", objName]) (takeFileName $ dropExtension s ++ ".a") - executeProcess ab ["-q",arName,objName] (takeFileName $ dropExtension s ++ ".o") + let otherOptions = map (("-I" ++) . normalise) ps ++ map macro ms + executeProcess cb (ff ++ otherOptions ++ ["-c", s, "-o", objName]) (takeFileName $ dropExtension s ++ ".a") + executeProcess ab ["-q",arName,objName] Bool isCategoryObjectFile (CategoryObjectFile _ _ _) = True isCategoryObjectFile (OtherObjectFile _) = False + +getObjectFiles :: ObjectFile -> [FilePath] +getObjectFiles (CategoryObjectFile _ _ os) = os +getObjectFiles (OtherObjectFile o) = [o] data ModuleConfig = ModuleConfig { diff --git a/src/Module/ParseMetadata.hs b/src/Module/ParseMetadata.hs --- a/src/Module/ParseMetadata.hs +++ b/src/Module/ParseMetadata.hs @@ -139,9 +139,10 @@ <*> parseRequired "hxx_files:" (parseList parseQuoted) <*> parseRequired "cxx_files:" (parseList parseQuoted) <*> parseRequired "binaries:" (parseList parseQuoted) + <*> parseRequired "libraries:" (parseList parseQuoted) <*> parseRequired "link_flags:" (parseList parseQuoted) <*> parseRequired "object_files:" (parseList readConfig) - writeConfig (CompileMetadata h p ns1 ns2 is is2 cs1 cs2 ds1 ds2 ps xs ts hxx cxx bs lf os) = do + writeConfig (CompileMetadata h p ns1 ns2 is is2 cs1 cs2 ds1 ds2 ps xs ts hxx cxx bs ls lf os) = do validateHash h ns1' <- maybeShowNamespace "public_namespace:" ns1 ns2' <- maybeShowNamespace "private_namespace:" ns2 @@ -188,6 +189,9 @@ "binaries: [" ] ++ indents (map show bs) ++ [ "]", + "libraries: [" + ] ++ indents (map show ls) ++ [ + "]", "link_flags: [" ] ++ indents (map show lf) ++ [ "]", @@ -338,10 +342,11 @@ sepAfter (string_ "binary") structOpen b <- runPermutation $ CompileBinary - <$> parseRequired "category:" sourceParser - <*> parseRequired "function:" sourceParser - <*> parseOptional "output:" "" parseQuoted - <*> parseOptional "link_flags:" [] (parseList parseQuoted) + <$> parseRequired "category:" sourceParser + <*> parseRequired "function:" sourceParser + <*> parseOptional "link_mode:" LinkDynamic parseLinkerMode + <*> parseOptional "output:" "" parseQuoted + <*> parseOptional "link_flags:" [] (parseList parseQuoted) structClose return b incremental = do @@ -351,13 +356,15 @@ <$> parseOptional "link_flags:" [] (parseList parseQuoted) structClose return lf - writeConfig (CompileBinary c f o lf) = do + writeConfig (CompileBinary c f lm o lf) = do validateCategoryName c validateFunctionName f + lm' <- showLinkerMode lm return $ [ "binary {", indent ("category: " ++ show c), indent ("function: " ++ show f), + indent ("link_mode: " ++ lm'), indent ("output: " ++ show o), indent ("link_flags: [") ] ++ (indents . indents) (map show lf) ++ [ @@ -373,6 +380,15 @@ "}" ] writeConfig _ = compilerErrorM "Invalid compile mode" + +parseLinkerMode :: TextParser LinkerMode +parseLinkerMode = labeled "linker mode" $ static <|> dynamic where + static = sepAfter (string_ "static") >> return LinkStatic + dynamic = sepAfter (string_ "dynamic") >> return LinkDynamic + +showLinkerMode :: ErrorContextM m => LinkerMode -> m String +showLinkerMode LinkStatic = return "static" +showLinkerMode LinkDynamic = return "dynamic" parseExprMacro :: TextParser (MacroName,Expression SourceContext) parseExprMacro = do diff --git a/src/Module/ProcessMetadata.hs b/src/Module/ProcessMetadata.hs --- a/src/Module/ProcessMetadata.hs +++ b/src/Module/ProcessMetadata.hs @@ -25,11 +25,13 @@ getCacheRelativePath, getExprMap, getIncludePathsForDeps, + getLibrariesForDeps, getLinkFlagsForDeps, getNamespacesForDeps, getObjectFilesForDeps, getObjectFileResolver, getRealPathsForDeps, + getRecompilePath, getSourceFilesForDeps, isPathConfigured, isPathUpToDate, @@ -135,6 +137,11 @@ m' <- autoWriteConfig m TrackedErrorsIO FilePath +getRecompilePath p = do + p' <- errorFromIO $ canonicalizePath p + return $ p' moduleFilename + eraseCachedData :: FilePath -> TrackedErrorsIO () eraseCachedData p = do let d = p cachedDataPath @@ -194,6 +201,9 @@ getLinkFlagsForDeps :: [CompileMetadata] -> [String] getLinkFlagsForDeps = concat . map cmLinkFlags +getLibrariesForDeps :: [CompileMetadata] -> [FilePath] +getLibrariesForDeps = concat . map cmLibraries + getObjectFilesForDeps :: [CompileMetadata] -> [ObjectFile] getObjectFilesForDeps = concat . map cmObjectFiles @@ -282,7 +292,7 @@ checkModuleVersionHash h m = cmVersionHash m == h checkModuleFreshness :: VersionHash -> MetadataMap -> FilePath -> CompileMetadata -> TrackedErrorsIO () -checkModuleFreshness h ca p m@(CompileMetadata _ p2 _ _ is is2 _ _ _ _ ps xs ts hxx cxx bs _ os) = do +checkModuleFreshness h ca p m@(CompileMetadata _ p2 _ _ is is2 _ _ _ _ ps xs ts hxx cxx bs ls _ os) = do time <- errorFromIO $ getModificationTime $ getCachedPath p "" metadataFilename (ps2,xs2,ts2) <- findSourceFiles p "" let rs = Set.toList $ Set.fromList $ concat $ map getRequires os @@ -297,6 +307,7 @@ (map (checkInput time . (p2 )) $ ps ++ xs) ++ (map (checkInput time . getCachedPath p2 "") $ hxx ++ cxx) ++ (map checkOutput bs) ++ + (map checkOutput ls) ++ (map checkObject os) ++ (map checkRequire rs) where @@ -313,7 +324,7 @@ when (not exists) $ compilerErrorM $ "Output file \"" ++ f ++ "\" is missing" checkDep time dep = do cm <- loadMetadata ca dep - mapCompilerM_ (checkInput time . (cmPath cm )) $ cmPublicFiles cm + mapCompilerM_ (checkInput time . (cmPath cm )) (cmPublicFiles cm) checkObject (CategoryObjectFile _ _ fs) = mapCompilerM_ checkOutput fs checkObject (OtherObjectFile f) = checkOutput f getRequires (CategoryObjectFile _ rs _) = rs diff --git a/src/Parser/Common.hs b/src/Parser/Common.hs --- a/src/Parser/Common.hs +++ b/src/Parser/Common.hs @@ -472,16 +472,16 @@ | otherwise = undefined parseDec :: TextParser Integer -parseDec = fmap snd $ parseIntCommon 10 digitChar +parseDec = labeled "base-10" $ fmap snd $ parseIntCommon 10 digitChar parseHex :: TextParser Integer -parseHex = fmap snd $ parseIntCommon 16 hexDigitChar +parseHex = labeled "base-16" $ fmap snd $ parseIntCommon 16 hexDigitChar parseOct :: TextParser Integer -parseOct = fmap snd $ parseIntCommon 8 octDigitChar +parseOct = labeled "base-8" $ fmap snd $ parseIntCommon 8 octDigitChar parseBin :: TextParser Integer -parseBin = fmap snd $ parseIntCommon 2 (oneOf "01") +parseBin = labeled "base-2" $ fmap snd $ parseIntCommon 2 (oneOf "01") parseSubOne :: TextParser (Integer,Integer) parseSubOne = parseIntCommon 10 digitChar diff --git a/src/Parser/IntegrationTest.hs b/src/Parser/IntegrationTest.hs --- a/src/Parser/IntegrationTest.hs +++ b/src/Parser/IntegrationTest.hs @@ -21,6 +21,8 @@ module Parser.IntegrationTest ( ) where +import Control.Applicative.Permutations + import Parser.Common import Parser.DefinedCategory () import Parser.Procedure () @@ -38,32 +40,36 @@ optionalSpace sepAfter (string_ "{") result <- resultCompiles <|> resultError <|> resultCrash <|> resultSuccess - args <- parseArgs <|> return [] + header <- runPermutation $ build c name result + <$> toPermutationWithDefault [] parseArgs + <*> toPermutationWithDefault Nothing parseTimeout + <*> toPermutation requireOrExclude sepAfter (string_ "}") - return $ IntegrationTestHeader [c] name args result where + return header where + build c name result args timeout (req,exc) = + IntegrationTestHeader [c] name args timeout (result req exc) resultCompiles = labeled "compiles expectation" $ do c <- getSourceContext keyword "compiles" - (req,exc) <- requireOrExclude - return $ ExpectCompiles [c] req exc + return $ ExpectCompiles [c] resultError = labeled "error expectation" $ do c <- getSourceContext keyword "error" - (req,exc) <- requireOrExclude - return $ ExpectCompilerError [c] req exc + return $ ExpectCompilerError [c] resultCrash = labeled "crash expectation" $ do c <- getSourceContext keyword "crash" - (req,exc) <- requireOrExclude - return $ ExpectRuntimeError [c] req exc + return $ ExpectRuntimeError [c] resultSuccess = labeled "success expectation" $ do c <- getSourceContext keyword "success" - (req,exc) <- requireOrExclude - return $ ExpectRuntimeSuccess [c] req exc + return $ ExpectRuntimeSuccess [c] parseArgs = labeled "testcase args" $ do keyword "args" many (sepAfter quotedString) + parseTimeout = labeled "testcase timeout" $ do + keyword "timeout" + fmap Just (sepAfter parseDec) requireOrExclude = parseAny2 require exclude where require = do keyword "require" diff --git a/src/Parser/Procedure.hs b/src/Parser/Procedure.hs --- a/src/Parser/Procedure.hs +++ b/src/Parser/Procedure.hs @@ -390,7 +390,8 @@ e <- notInfix asInfix [e] [] <|> return e where - notInfix = literal <|> unary <|> initalize <|> expression + -- NOTE: InitializeValue is parsed as ExpressionStart. + notInfix = literal <|> unary <|> expression asInfix es os = do c <- getSourceContext o <- infixOperator <|> functionOperator @@ -423,15 +424,6 @@ s <- sourceParser vs <- many sourceParser return $ Expression [c] s vs - initalize = do - c <- getSourceContext - t <- try $ do -- Avoids consuming the type name if { isn't present. - t2 <- (paramSelf >> return Nothing) <|> fmap Just sourceParser - sepAfter (labeled "@value initializer" $ string_ "{") - return t2 - as <- sepBy sourceParser (sepAfter $ string_ ",") - sepAfter (string_ "}") - return $ InitializeValue [c] t (Positional as) instance ParseFromSource (FunctionQualifier SourceContext) where -- TODO: This is probably better done iteratively. @@ -513,7 +505,12 @@ sourceContext <|> exprLookup <|> categoryCall <|> - typeCall where + -- Keep this before typeCall, since it does a look-ahead for {. + initalize <|> + typeCall <|> + stringLiteral <|> + charLiteral <|> + boolLiteral where parens = do c <- getSourceContext sepAfter (string_ "(") @@ -542,7 +539,7 @@ sourceContext = do pragma <- pragmaSourceContext case pragma of - (PragmaSourceContext c) -> return $ ParensExpression [c] $ Literal (StringLiteral [c] (show c)) + (PragmaSourceContext c) -> return $ UnambiguousLiteral (StringLiteral [c] (show c)) _ -> undefined -- Should be caught above. exprLookup = do pragma <- pragmaExprLookup @@ -574,27 +571,39 @@ n <- sourceParser f <- parseFunctionCall c n return $ TypeCall [c] t f - -instance ParseFromSource (ValueLiteral SourceContext) where - sourceParser = labeled "literal" $ - stringLiteral <|> - charLiteral <|> - escapedInteger <|> - integerOrDecimal <|> - boolLiteral <|> - emptyLiteral where + initalize = do + c <- getSourceContext + t <- try $ do -- Avoids consuming the type name if { isn't present. + t2 <- (paramSelf >> return Nothing) <|> fmap Just sourceParser + sepAfter (labeled "@value initializer" $ string_ "{") + return t2 + as <- sepBy sourceParser (sepAfter $ string_ ",") + sepAfter (string_ "}") + return $ InitializeValue [c] t (Positional as) stringLiteral = do c <- getSourceContext ss <- quotedString optionalSpace - return $ StringLiteral [c] ss + return $ UnambiguousLiteral $ StringLiteral [c] ss charLiteral = do c <- getSourceContext string_ "'" ch <- stringChar <|> char '"' string_ "'" optionalSpace - return $ CharLiteral [c] ch + return $ UnambiguousLiteral $ CharLiteral [c] ch + boolLiteral = do + c <- getSourceContext + b <- try $ (kwTrue >> return True) <|> (kwFalse >> return False) + return $ UnambiguousLiteral $ BoolLiteral [c] b + +instance ParseFromSource (ValueLiteral SourceContext) where + sourceParser = labeled "literal" $ + -- NOTE: StringLiteral, CharLiteral, and BoolLiteral are parsed + -- as ExpressionStart. + escapedInteger <|> + integerOrDecimal <|> + emptyLiteral where escapedInteger = do c <- getSourceContext escapeStart @@ -629,10 +638,6 @@ integer c d = do optionalSpace return $ IntegerLiteral [c] False d - boolLiteral = do - c <- getSourceContext - b <- try $ (kwTrue >> return True) <|> (kwFalse >> return False) - return $ BoolLiteral [c] b emptyLiteral = do c <- getSourceContext kwEmpty diff --git a/src/Test/IntegrationTest.hs b/src/Test/IntegrationTest.hs --- a/src/Test/IntegrationTest.hs +++ b/src/Test/IntegrationTest.hs @@ -40,6 +40,8 @@ let h = itHeader t when (not $ isExpectCompiles $ ithResult h) $ compilerErrorM "Expected ExpectCompiles" checkEquals (ithTestName h) "basic compiles test" + containsExactly (ithArgs h) [] + checkEquals (ithTimeout h) Nothing containsExactly (getRequirePattern $ ithResult h) [ OutputPattern OutputCompiler "pattern in output 1", OutputPattern OutputAny "pattern in output 2" @@ -58,6 +60,8 @@ let h = itHeader t when (not $ isExpectCompilerError $ ithResult h) $ compilerErrorM "Expected ExpectCompilerError" checkEquals (ithTestName h) "basic error test" + containsExactly (ithArgs h) [] + checkEquals (ithTimeout h) Nothing containsExactly (getRequirePattern $ ithResult h) [ OutputPattern OutputCompiler "pattern in output 1", OutputPattern OutputAny "pattern in output 2" @@ -75,7 +79,8 @@ (\t -> do let h = itHeader t when (not $ isExpectRuntimeError $ ithResult h) $ compilerErrorM "Expected ExpectRuntimeError" - checkEquals (ithTestName h) "basic crash test" + containsExactly (ithArgs h) ["arg1","arg2","arg3"] + checkEquals (ithTimeout h) (Just 10) containsExactly (getRequirePattern $ ithResult h) [ OutputPattern OutputAny "pattern in output 1", OutputPattern OutputAny "pattern in output 2" @@ -94,6 +99,8 @@ let h = itHeader t when (not $ isExpectRuntimeSuccess $ ithResult h) $ compilerErrorM "Expected ExpectRuntimeSuccess" checkEquals (ithTestName h) "basic success test" + containsExactly (ithArgs h) [] + checkEquals (ithTimeout h) (Just 0) containsExactly (getRequirePattern $ ithResult h) [ OutputPattern OutputAny "pattern in output 1", OutputPattern OutputAny "pattern in output 2" diff --git a/src/Test/ParseMetadata.hs b/src/Test/ParseMetadata.hs --- a/src/Test/ParseMetadata.hs +++ b/src/Test/ParseMetadata.hs @@ -89,6 +89,10 @@ "/home/project/special/binary1", "/home/project/special/binary2" ], + cmLibraries = [ + "/home/project/special/library1", + "/home/project/special/library2" + ], cmLinkFlags = [ "-lm", "-ldl" @@ -180,6 +184,7 @@ cmHxxFiles = [], cmCxxFiles = [], cmBinaries = [], + cmLibraries = [], cmLinkFlags = [], cmObjectFiles = [] }, @@ -201,6 +206,7 @@ cmHxxFiles = [], cmCxxFiles = [], cmBinaries = [], + cmLibraries = [], cmLinkFlags = [], cmObjectFiles = [] }, @@ -222,6 +228,7 @@ cmHxxFiles = [], cmCxxFiles = [], cmBinaries = [], + cmLibraries = [], cmLinkFlags = [], cmObjectFiles = [] }, @@ -245,6 +252,7 @@ cmHxxFiles = [], cmCxxFiles = [], cmBinaries = [], + cmLibraries = [], cmLinkFlags = [], cmObjectFiles = [] }, @@ -268,6 +276,7 @@ cmHxxFiles = [], cmCxxFiles = [], cmBinaries = [], + cmLibraries = [], cmLinkFlags = [], cmObjectFiles = [] }, @@ -322,13 +331,23 @@ checkWriteThenRead $ CompileBinary { cbCategory = CategoryName "SpecialCategory", cbFunction = FunctionName "specialFunction", + cbLinker = LinkStatic, cbOutputName = "binary", cbLinkFlags = [] }, + checkWriteThenRead $ CompileBinary { + cbCategory = CategoryName "SpecialCategory", + cbFunction = FunctionName "specialFunction", + cbLinker = LinkDynamic, + cbOutputName = "binary", + cbLinkFlags = [] + }, + checkWriteFail "bad category" $ CompileBinary { cbCategory = CategoryName "bad category", cbFunction = FunctionName "specialFunction", + cbLinker = LinkDynamic, cbOutputName = "binary", cbLinkFlags = [] }, @@ -336,6 +355,7 @@ checkWriteFail "bad function" $ CompileBinary { cbCategory = CategoryName "SpecialCategory", cbFunction = FunctionName "bad function", + cbLinker = LinkDynamic, cbOutputName = "binary", cbLinkFlags = [] }, @@ -368,7 +388,7 @@ Expression _ (TypeCall _ _ (FunctionCall _ (FunctionName "execute") (Positional []) - (Positional [Literal (StringLiteral _ "this is a string\n")]))) []) + (Positional [Expression _ (UnambiguousLiteral (StringLiteral _ "this is a string\n")) []]))) []) ] -> True _ -> False), diff --git a/src/Test/Procedure.hs b/src/Test/Procedure.hs --- a/src/Test/Procedure.hs +++ b/src/Test/Procedure.hs @@ -69,9 +69,17 @@ checkShortParseFail "\\ T<#x> var", checkShortParseSuccess "\\ T<#x>{ val, var.T<#x>.func() }", checkShortParseFail "\\ T<#x>{ val var.T<#x>.func() }", - checkShortParseFail "\\ T<#x>{}.call()", + checkShortParseSuccess "\\ T<#x>{}.call()", checkShortParseFail "\\ T<#x>$call()", checkShortParseSuccess "\\ (T<#x>{}).call()", + checkShortParseSuccess "\\ (\"abc\").call()", + checkShortParseSuccess "\\ \"abc\".call()", + checkShortParseSuccess "\\ ('a').call()", + checkShortParseSuccess "\\ 'a'.call()", + checkShortParseSuccess "\\ (false).call()", + checkShortParseSuccess "\\ false.call()", + checkShortParseFail "\\ 1.call()", + checkShortParseFail "\\ empty.call()", checkShortParseSuccess "x <- var.func()", checkShortParseFail "x <- var.func() var.func()", @@ -196,7 +204,7 @@ checkShortParseFail "x <- \"fsdfd", checkShortParseFail "x <- \"\"fsdfd", checkShortParseSuccess "x <- 123.0 + z.call()", - checkShortParseFail "x <- \"123\".call()", + checkShortParseSuccess "x <- \"123\".call()", checkShortParseFail "x <- 123.call()", checkShortParseSuccess "x <- 'x'", checkShortParseSuccess "x <- '\\xAA'", @@ -217,7 +225,7 @@ checkParsesAs "'\"'" (\e -> case e of - (Literal (CharLiteral _ '"')) -> True + (Expression _ (UnambiguousLiteral (CharLiteral _ '"')) []) -> True _ -> False), checkParsesAs "1 + 2 < 4 && 3 >= 1 * 2 + 1 || true" @@ -236,7 +244,7 @@ (Literal (IntegerLiteral _ False 1)) (NamedOperator _ "*") (Literal (IntegerLiteral _ False 2))) (NamedOperator _ "+") (Literal (IntegerLiteral _ False 1)))) (NamedOperator _ "||") - (Literal (BoolLiteral _ True)))) -> True + (Expression _ (UnambiguousLiteral (BoolLiteral _ True)) []))) -> True _ -> False), -- This expression isn't really valid, but it ensures that the first ! is diff --git a/src/Test/TrackedErrors.hs b/src/Test/TrackedErrors.hs --- a/src/Test/TrackedErrors.hs +++ b/src/Test/TrackedErrors.hs @@ -20,6 +20,9 @@ module Test.TrackedErrors (tests) where +import Control.Arrow (first) +import Control.Monad.Writer + import Base.CompilerError import Base.TrackedErrors @@ -84,8 +87,35 @@ checkSuccess 'a' ((resetBackgroundM $ compilerBackgroundM "background") >> return 'a'), checkError "error\n" - ((resetBackgroundM $ compilerBackgroundM "background") >> compilerErrorM "error" :: TrackedErrorsIO ()) + ((resetBackgroundM $ compilerBackgroundM "background") >> compilerErrorM "error" :: TrackedErrorsIO ()), + + checkWriterSuccess ('x',"ab") (ifElseSuccessT (lift (tell "a") >> return 'x') (tell "b") (tell "c")), + checkWriterFail ("failed\n","ac") (ifElseSuccessT (lift (tell "a") >> compilerErrorM "failed") (tell "b") (tell "c") :: TrackedErrorsT (Writer String) ()) ] + +checkWriterSuccess :: (Eq a, Show a) => (a,String) -> TrackedErrorsT (Writer String) a -> IO (TrackedErrors ()) +checkWriterSuccess x y = do + let (failed,_) = runWriter $ isCompilerErrorT y + if failed + then return $ fst $ runWriter $ toTrackedErrors $ y >> return () + else do + let y' = runWriter $ getCompilerSuccessT y + if y' == x + then return $ return () + else return $ compilerErrorM $ "Expected value " ++ show x ++ " but got value " ++ show y' + +checkWriterFail :: (Eq a, Show a) => (String,String) -> TrackedErrorsT (Writer String) a -> IO (TrackedErrors ()) +checkWriterFail x y = do + let (failed,_) = runWriter $ isCompilerErrorT y + if failed + then do + let y' = first show $ runWriter $ getCompilerErrorT y + if y' == x + then return $ return () + else return $ compilerErrorM $ "Expected error " ++ show x ++ " but got error " ++ show y' + else do + let y' = runWriter $ getCompilerSuccessT y + return $ compilerErrorM $ "Expected failure but got value " ++ show y' checkSuccess :: (Eq a, Show a) => a -> TrackedErrorsIO a -> IO (TrackedErrors ()) checkSuccess x y = do diff --git a/src/Test/TypeCategory.hs b/src/Test/TypeCategory.hs --- a/src/Test/TypeCategory.hs +++ b/src/Test/TypeCategory.hs @@ -1187,7 +1187,7 @@ prefix = show ts ++ " " ++ showFilters pa check gs2 c | isCompilerError c = compilerErrorM $ prefix ++ ":\n" ++ show (getCompilerWarnings c) ++ show (getCompilerError c) - | otherwise = getCompilerSuccess c `containsExactly` gs2 + | otherwise = (Map.toList $ getCompilerSuccess c) `containsExactly` Map.toList gs2 checkInferenceFail :: CategoryMap SourceContext -> [(String, [String])] -> [String] -> [(String,String)] -> TrackedErrors () @@ -1195,9 +1195,9 @@ prefix = show ts ++ " " ++ showFilters pa check _ c | isCompilerError c = return () - | otherwise = compilerErrorM $ prefix ++ ": Expected failure\n" + | otherwise = compilerErrorM $ prefix ++ ": Expected failure\n" -checkInferenceCommon :: ([InferredTypeGuess] -> TrackedErrors [InferredTypeGuess] -> TrackedErrors ()) -> +checkInferenceCommon :: (ParamValues -> TrackedErrors ParamValues -> TrackedErrors ()) -> CategoryMap SourceContext -> [(String,[String])] -> [String] -> [(String,String)] -> [(String,String)] -> TrackedErrors () checkInferenceCommon check tm pa is ts gs = checked not $ k `Set.member` ka) pa2 let ff = Map.filterWithKey (\k _ -> k `Set.member` ka) pa2 gs2 <- inferParamTypes r f ia2 ts2 @@ -1219,7 +1219,7 @@ parseGuess (p,t) = do p' <- readSingle "(string)" p t' <- readSingle "(string)" t - return $ InferredTypeGuess p' t' Invariant + return (p',t') parsePair im v (t1,t2) = do t1' <- readSingle "(string)" t1 t2' <- readSingle "(string)" t2 >>= uncheckedSubValueType (weakLookup im) diff --git a/src/Test/testfiles/basic_crash_test.0rt b/src/Test/testfiles/basic_crash_test.0rt --- a/src/Test/testfiles/basic_crash_test.0rt +++ b/src/Test/testfiles/basic_crash_test.0rt @@ -4,6 +4,8 @@ exclude "pattern not in output 1" require "pattern in output 2" exclude "pattern not in output 2" + args "arg1" "arg2" "arg3" + timeout 10 } concrete Test { diff --git a/src/Test/testfiles/basic_success_test.0rt b/src/Test/testfiles/basic_success_test.0rt --- a/src/Test/testfiles/basic_success_test.0rt +++ b/src/Test/testfiles/basic_success_test.0rt @@ -4,6 +4,7 @@ exclude "pattern not in output 1" require "pattern in output 2" exclude "pattern not in output 2" + timeout 0 } concrete Test { diff --git a/src/Test/testfiles/function_filter_type_param.0rx b/src/Test/testfiles/function_filter_type_param.0rx new file mode 100644 --- /dev/null +++ b/src/Test/testfiles/function_filter_type_param.0rx @@ -0,0 +1,11 @@ +@value interface Base1 {} + +@type interface Base2 {} + +concrete Type<#x|#y|#z> { + @type call + #x allows Base1 + #y requires Base1 + #z defines Base2 + (#x,#y) -> (#y,#z) +} diff --git a/src/Test/testfiles/module-cache.txt b/src/Test/testfiles/module-cache.txt --- a/src/Test/testfiles/module-cache.txt +++ b/src/Test/testfiles/module-cache.txt @@ -70,6 +70,10 @@ "/home/project/special/binary1" "/home/project/special/binary2" ] +libraries: [ + "/home/project/special/library1" + "/home/project/special/library2" +] link_flags: [ "-lm" "-ldl" diff --git a/src/Types/Builtin.hs b/src/Types/Builtin.hs --- a/src/Types/Builtin.hs +++ b/src/Types/Builtin.hs @@ -24,7 +24,6 @@ boolRequiredValue, charRequiredValue, defaultCategories, - defaultCategoryDeps, emptyType, floatRequiredValue, formattedRequiredValue, @@ -34,7 +33,6 @@ ) where import qualified Data.Map as Map -import qualified Data.Set as Set import Base.GeneralType import Base.Positional @@ -44,9 +42,6 @@ defaultCategories :: CategoryMap c defaultCategories = Map.empty - -defaultCategoryDeps :: Set.Set CategoryName -defaultCategoryDeps = Set.fromList [] boolRequiredValue :: ValueType boolRequiredValue = requiredSingleton BuiltinBool diff --git a/src/Types/IntegrationTest.hs b/src/Types/IntegrationTest.hs --- a/src/Types/IntegrationTest.hs +++ b/src/Types/IntegrationTest.hs @@ -42,6 +42,7 @@ ithContext :: [c], ithTestName :: String, ithArgs :: [String], + ithTimeout :: Maybe Integer, ithResult :: ExpectedResult c } diff --git a/src/Types/Procedure.hs b/src/Types/Procedure.hs --- a/src/Types/Procedure.hs +++ b/src/Types/Procedure.hs @@ -232,7 +232,6 @@ Literal (ValueLiteral c) | UnaryExpression [c] (Operator c) (Expression c) | InfixExpression [c] (Expression c) (Operator c) (Expression c) | - InitializeValue [c] (Maybe TypeInstance) (Positional (Expression c)) | RawExpression ExpressionType ExpressionValue deriving (Show) @@ -280,7 +279,6 @@ getExpressionContext (Literal l) = getValueLiteralContext l getExpressionContext (UnaryExpression c _ _) = c getExpressionContext (InfixExpression c _ _ _) = c -getExpressionContext (InitializeValue c _ _) = c getExpressionContext (RawExpression _ _) = [] data FunctionCall c = @@ -295,7 +293,9 @@ UnqualifiedCall [c] (FunctionCall c) | BuiltinCall [c] (FunctionCall c) | ParensExpression [c] (Expression c) | - InlineAssignment [c] VariableName (Expression c) + InlineAssignment [c] VariableName (Expression c) | + InitializeValue [c] (Maybe TypeInstance) (Positional (Expression c)) | + UnambiguousLiteral (ValueLiteral c) deriving (Show) data ValueLiteral c = diff --git a/src/Types/TypeCategory.hs b/src/Types/TypeCategory.hs --- a/src/Types/TypeCategory.hs +++ b/src/Types/TypeCategory.hs @@ -59,7 +59,6 @@ getFunctionFilterMap, getInstanceCategory, getValueCategory, - guessesAsParams, includeNewTypes, inferParamTypes, instanceFromCategory, @@ -86,7 +85,7 @@ ) where import Control.Arrow (second) -import Control.Monad ((>=>),when) +import Control.Monad ((>=>),foldM,when) import Data.List (group,groupBy,intercalate,nub,nubBy,sort,sortBy) import qualified Data.Map as Map import qualified Data.Set as Set @@ -1044,9 +1043,6 @@ return (PatternMatch v t1 t2') matchPattern (PatternMatch v t1 t2) = checkValueTypeMatch r f v t1 t2 -guessesAsParams :: [InferredTypeGuess] -> ParamValues -guessesAsParams gs = Map.fromList $ zip (map itgParam gs) (map itgGuess gs) - data GuessRange a = GuessRange { grLower :: Maybe a, @@ -1066,15 +1062,13 @@ } mergeInferredTypes :: (CollectErrorsM m, TypeResolver r) => - r -> ParamFilters -> ParamFilters -> ParamValues -> MergeTree InferredTypeGuess -> - m [InferredTypeGuess] + r -> ParamFilters -> ParamFilters -> ParamValues -> MergeTree InferredTypeGuess -> m ParamValues mergeInferredTypes r f ff ps gs0 = do let gs0' = mapTypeGuesses gs0 - mapCompilerM reduce $ Map.toList gs0' where - reduce (i,is) = do - (GuessUnion gs) <- reduceMergeTree anyOp allOp leafOp is >>= filterGuesses i - t <- takeBest i gs - return (InferredTypeGuess i t Invariant) + gs1 <- mapCompilerM (\(i,is) -> fmap ((,) i) $ (reduce >=> simplifyUnion) is) $ Map.toList gs0' + gs2 <- filterGuesses gs1 + takeBest gs2 where + reduce is = fmap guGuesses $ reduceMergeTree anyOp allOp leafOp is leafOp (InferredTypeGuess _ t Covariant) = return $ GuessUnion [GuessRange (Just t) Nothing] leafOp (InferredTypeGuess _ t Contravariant) = return $ GuessUnion [GuessRange Nothing (Just t)] leafOp (InferredTypeGuess _ t _) = return $ GuessUnion [GuessRange (Just t) (Just t)] @@ -1137,33 +1131,37 @@ (Just lo,Just hi) -> return $ Just $ ms ++ [GuessRange lo hi] ++ gs _ -> tryRangeUnion (ms ++ [g2]) g1 gs tryRangeUnion _ _ _ = return Nothing - takeBest _ [(GuessRange (Just lo) Nothing)] = return lo - takeBest _ [(GuessRange Nothing (Just hi))] = return hi - takeBest i [g@(GuessRange (Just lo) (Just hi))] = do - same <- (Just hi) `convertsTo` (Just lo) - when (not same) $ compilerErrorM (show g) > return g - filterGuess i g@(GuessRange Nothing (Just hi)) = checkSubFilters i hi >> return g - filterGuess i g@(GuessRange (Just lo) (Just hi)) = do - let checkLo = checkSubFilters i lo - let checkHi = checkSubFilters i hi - pLo <- isCompilerErrorM checkLo - pHi <- isCompilerErrorM checkHi - case (pLo,pHi) of - (True,True) -> collectAllM_ [checkLo,checkHi] >> emptyErrorM - (True,_) -> return $ GuessRange Nothing (Just hi) - (_,True) -> return $ GuessRange (Just lo) Nothing - _ -> return g - filterGuess _ _ = emptyErrorM - checkSubFilters i t = "In guess " ++ show t ++ " for param " ++ show i ??> do - let ps' = Map.insert i t ps - fs <- ff `filterLookup` i - fs' <- mapCompilerM (uncheckedSubFilter (getValueForParam ps')) fs - validateAssignment r f t fs' + takeBest [gs] = return $ Map.fromList gs + takeBest gs = "No feasible param guesses found" !!> do + mapCompilerM_ showAmbiguous (zip ([1..] :: [Int]) gs) + emptyErrorM + showAmbiguous (n,gs) = "Param guess set " ++ show n !!> + (mapErrorsM $ map (\(i,t) -> "Guess for param " ++ show i ++ ": " ++ show t) gs) + filterGuesses gs = do + gs' <- mapCompilerM extractGuesses gs + let mult = foldM (\xs ys -> [xs++[y] | y <- ys]) [] gs' + let gs2 = map filterGuess mult + collectFirstM_ gs2 > return gs + extractGuesses (i,is) = do + let is2 = map (extractSingle i) is + collectFirstM_ is2 do + let ps' = foldr (uncurry Map.insert) ps gs + ff' <- uncheckedSubFilters (getValueForParam ps') ff + mapCompilerM_ (validateSingleParam ff') gs + validateSingleParam ff2 (i,t) = do + fs <- ff2 `filterLookup` i + validateAssignment r f t fs + describeGuess = intercalate ", " . map (\(i,t) -> show i ++ " = " ++ show t) diff --git a/tests/builtin-types.0rt b/tests/builtin-types.0rt --- a/tests/builtin-types.0rt +++ b/tests/builtin-types.0rt @@ -383,28 +383,28 @@ } unittest stringFormatted { - String s <- ("x").formatted() + String s <- "x".formatted() if (s != "x") { fail(s) } } unittest charFormatted { - String s <- ('x').formatted() + String s <- 'x'.formatted() if (s != "x") { fail(s) } } unittest charFormattedOct { - String s <- ('\170').formatted() + String s <- '\170'.formatted() if (s != "x") { fail(s) } } unittest charFormattedHex { - String s <- ('\x78').formatted() + String s <- '\x78'.formatted() if (s != "x") { fail(s) } @@ -443,45 +443,33 @@ success } -unittest boolShared { - Bool value1 <- true - // Shared because true and false are boxed constants. - weak Bool value2 <- value1 - if (!present(strong(value2))) { - fail("Failed") - } +unittest boolNotReferenceCounted { + weak Bool value <- true + \ Testing.checkPresent(strong(value)) } -unittest stringShared { - String value1 <- "x" - weak String value2 <- value1 - if (!present(strong(value2))) { - fail("Failed") - } +unittest charNotReferenceCounted { + weak Char value <- 'x' + \ Testing.checkPresent(strong(value)) } -unittest charNotShared { - Char value1 <- 'x' - weak Char value2 <- value1 - if (present(strong(value2))) { - fail("Failed") - } +unittest intNotReferenceCounted { + weak Int value <- 1 + \ Testing.checkPresent(strong(value)) } -unittest intNotShared { - Int value1 <- 1 - weak Int value2 <- value1 - if (present(strong(value2))) { - fail("Failed") - } +unittest floatNotReferenceCounted { + weak Float value <- 1.0 + \ Testing.checkPresent(strong(value)) } -unittest floatNotShared { - Float value1 <- 1.1 - weak Float value2 <- value1 - if (present(strong(value2))) { - fail("Failed") - } +unittest stringReferenceCounted { + weak String value2 <- empty + scoped { + String value1 <- "x" + value2 <- value1 + } in \ Testing.checkPresent(strong(value2)) + \ Testing.checkEmpty(strong(value2)) } @@ -636,7 +624,7 @@ if ("abc\x00def" == "abc") { fail("Failed") } - if (("abc\x00def").readAt(4) != 'd') { + if ("abc\x00def".readAt(4) != 'd') { fail("Failed") } } @@ -676,7 +664,7 @@ define Test { run () { - \ ("abc").readAt(-10) + \ "abc".readAt(-10) } } @@ -697,7 +685,7 @@ define Test { run () { - \ ("abc").readAt(3) + \ "abc".readAt(3) } } @@ -718,7 +706,7 @@ define Test { run () { - \ ("abc").subSequence(1,3) + \ "abc".subSequence(1,3) } } @@ -727,28 +715,47 @@ } +testcase "Char stuff" { + success +} + +unittest accurateMax { + \ Testing.checkEquals(Char.maxBound().asInt(),255) +} + +unittest accurateMin { + \ Testing.checkEquals(Char.minBound().asInt(),0) +} + +unittest asIntIsUnsigned { + \ Testing.checkEquals('\xff'.asInt(),255) +} + +unittest asFloatIsUnsigned { + \ Testing.checkEquals('\xff'.asFloat(),255.0) +} + + testcase "Int stuff" { success } unittest accurateMax { - Int x <- 9223372036854775807 - 1 - if (x != 9223372036854775806) { - fail(x) - } + \ Testing.checkEquals(Int.maxBound(),9223372036854775807) } unittest accurateMin { - Int x <- -9223372036854775806 + 1 - if (x != -9223372036854775805) { - fail(x) - } + \ Testing.checkEquals(Int.minBound(),-9223372036854775808) } +unittest asCharIsPeriodic { + \ Testing.checkEquals((65).asChar(),(65+256).asChar()) + \ Testing.checkEquals((65).asChar(),(65+1024).asChar()) + \ Testing.checkEquals((65).asChar(),(65-1024).asChar()) +} + unittest hexUnsigned { - if (\xffffffffffffffff != -1) { - fail("Failed") - } + \ Testing.checkEquals(\xffffffffffffffff,-1) } @@ -788,13 +795,13 @@ testcase "Int literal too small" { error - require "-9223372036854775807" + require "-9223372036854775809" require "min" } define Test { run () { - \ -9223372036854775807 + \ -9223372036854775809 } } @@ -871,35 +878,35 @@ } unittest nullAsBool { - Bool b1 <- ('\x00').asBool() + Bool b1 <- '\x00'.asBool() if (b1 != false) { fail(b1) } } unittest nonNullAsBool { - Bool b2 <- ('\x10').asBool() + Bool b2 <- '\x10'.asBool() if (b2 != true) { fail(b2) } } unittest asChar { - Char c <- ('a').asChar() + Char c <- 'a'.asChar() if (c != 'a') { fail(c) } } unittest asInt { - Int i <- ('\x10').asInt() + Int i <- '\x10'.asInt() if (i != 16) { fail(i) } } unittest asFloat { - Float f <- ('\x10').asFloat() + Float f <- '\x10'.asFloat() if (f != 16.0) { fail(f) } @@ -984,14 +991,14 @@ } unittest emptyAsBool { - Bool b1 <- ("").asBool() + Bool b1 <- "".asBool() if (b1 != false) { fail(b1) } } unittest singleNullAsBool { - Bool b2 <- ("\x00").asBool() + Bool b2 <- "\x00".asBool() if (b2 != true) { fail(b2) } diff --git a/tests/cli-tests.sh b/tests/cli-tests.sh --- a/tests/cli-tests.sh +++ b/tests/cli-tests.sh @@ -78,6 +78,35 @@ } +test_leak_check() { + local binary="$ZEOLITE_PATH/tests/leak-check/LeakTest" + rm -f "$binary" + do_zeolite -p "$ZEOLITE_PATH" -r tests/leak-check -f + # race-condition check + # NOTE: If this fails, the valgrind check will be skipped. + local output=$(execute "$binary" 'race' || true) + if ! echo "$output" | egrep -q 'no race conditions this time'; then + show_message 'Unexpected race-condition results from tests/leak-check:' + echo "$output" 1>&2 + return 1 + fi + # valgrind check + if [[ -x "$(which valgrind)" ]]; then + local output=$(execute valgrind --leak-check=yes "$binary" 'leak' || true) + if ! echo "$output" | egrep -q 'lost: 0 bytes in 0 blocks'; then + show_message 'Unexpected valgrind results from tests/leak-check:' + echo "$output" 1>&2 + return 1 + fi + if echo "$output" | egrep -q 'lost: [1-9][0-9]* bytes'; then + show_message 'Unexpected valgrind results from tests/leak-check:' + echo "$output" 1>&2 + return 1 + fi + fi +} + + test_tests_only() { local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/tests-only -f || true) if ! echo "$output" | egrep -q 'Type1 .+ visible category'; then @@ -233,39 +262,14 @@ } -test_fast() { - local temp=$(execute mktemp -d) - local category='HelloWorld' - local file="$temp/hello-world.0rx" - create_file "$file" < () -} - -define $category { - run () { - \ LazyStream.new() - .append(\$ExprLookup[MODULE_PATH]\$ + "\n") - .append("Hello World\n") - .writeTo(SimpleOutput.stdout()) - } -} -END - do_zeolite -I lib/util --fast $category "$file" - local output=$(execute "$PWD/$category") - if ! echo "$output" | fgrep -xq 'Hello World'; then - show_message 'Expected "Hello World" in program output:' - echo "$output" 1>&2 - return 1 - fi - if ! echo "$output" | fgrep -xq "$PWD"; then - show_message 'Expected $PWD in program output:' +test_fast_static() { + do_zeolite -p "$ZEOLITE_PATH/tests/fast-static" -I lib/util --fast Program program.0rx + local output=$(execute "$ZEOLITE_PATH/tests/fast-static/Program") + if ! echo "$output" | fgrep -xq 'Static linking works!'; then + show_message 'Expected "Static linking works!" in program output:' echo "$output" 1>&2 return 1 fi - execute rm -r "$temp" "$PWD/$category" || true } @@ -307,7 +311,7 @@ local binary="$ZEOLITE_PATH/example/hello/HelloDemo" local name='Cli Tests' rm -f "$binary" - do_zeolite -p "$ZEOLITE_PATH" -I lib/util -m HelloDemo example/hello -f + do_zeolite -p "$ZEOLITE_PATH/example/hello" -I lib/util --fast HelloDemo hello-demo.0rx local output=$(echo "$name" | execute_noredir "$binary" 2>&1) if ! echo "$output" | egrep -q "\"$name\""; then show_message "Expected \"$name\" in HelloDemo output:" @@ -331,7 +335,7 @@ do_zeolite -p "$ZEOLITE_PATH" -r example/primes -f { echo; - sleep 0.01; + sleep 0.1; echo; echo "exit"; } | execute_noredir "$binary" 2> /dev/null | head -n100 | tr $'\n' ',' > "$temp" @@ -380,6 +384,7 @@ ALL_TESTS=( test_bad_path test_check_defs + test_leak_check test_tests_only test_tests_only2 test_tests_only3 @@ -391,7 +396,7 @@ test_warn_public test_templates test_show_deps - test_fast + test_fast_static test_bad_system_include test_global_include test_example_hello diff --git a/tests/fast-static/README.md b/tests/fast-static/README.md new file mode 100644 --- /dev/null +++ b/tests/fast-static/README.md @@ -0,0 +1,18 @@ +# Static Linking and `--fast` Mode + +Compiling and executing the program in this module should always succeed. +Specifically, static linking in `--fast` mode should not have linker errors. + +To compile and run: + +```shell +ZEOLITE_PATH=$(zeolite --get-path) +zeolite -p "$ZEOLITE_PATH/tests/fast-static" -I lib/util --fast Program program.0rx +$ZEOLITE_PATH/tests/fast-static/Program +``` + +The program output should look like this: + +```text +Static linking works! +``` diff --git a/tests/fast-static/program.0rx b/tests/fast-static/program.0rx new file mode 100644 --- /dev/null +++ b/tests/fast-static/program.0rx @@ -0,0 +1,12 @@ +concrete Program { + @type run () -> () +} + +define Program { + run () { + \ LazyStream.new() + .append($ExprLookup[MODULE_PATH]$ + "\n") + .append("Static linking works!\n") + .writeTo(SimpleOutput.stdout()) + } +} diff --git a/tests/inference.0rt b/tests/inference.0rt --- a/tests/inference.0rt +++ b/tests/inference.0rt @@ -296,17 +296,14 @@ } -testcase "mutually dependent inferences" { - error - require "get" - require "#x.+Int" - require "#y.+String" +testcase "mutually dependent filters" { + success } unittest test { - Type x <- Type.create() - Type y <- Type.create() - \ Test.get(x,y) + Type x <- Type.create() + Type y <- Type.create() + \ Test.get(x,y) } concrete Type<#x> { @@ -321,13 +318,46 @@ concrete Test { @type get<#x,#y> - #x requires Type<#y> - #y requires Type<#x> - (#x,#y) -> () + #x defines LessThan<#y> + #y defines LessThan<#x> + (Type<#x>,Type<#y>) -> () } define Test { get (_,_) {} +} + + +testcase "two inferences in one filter" { + success +} + +unittest test { + Type z <- Type.create() + \ Test.get(z,1,"message") +} + +@type interface Base<#x,#y> {} + +concrete Type { + defines Base + @type create () -> (Type) +} + +define Type { + create () { + return Type{ } + } +} + +concrete Test { + @type get<#z,#x,#y> + #z defines Base<#x,#y> + (#z,#x,#y) -> () +} + +define Test { + get (_,_,_) {} } diff --git a/tests/leak-check/.zeolite-module b/tests/leak-check/.zeolite-module new file mode 100644 --- /dev/null +++ b/tests/leak-check/.zeolite-module @@ -0,0 +1,17 @@ +root: "../.." +path: "tests/leak-check" +expression_map: [ + expression_macro { + name: CPU_CORE_COUNT + expression: 8 + } +] +private_deps: [ + "lib/container" + "lib/thread" + "lib/util" +] +mode: binary { + category: LeakTest + function: run +} diff --git a/tests/leak-check/README.md b/tests/leak-check/README.md new file mode 100644 --- /dev/null +++ b/tests/leak-check/README.md @@ -0,0 +1,65 @@ +# Leak and Race Condition Testing + +The program in this module is meant to overload the reference-counting system +by forcing memory leaks and race conditions. Ideally, those things *will not* +happen. + +To compile the test program: + +```shell +ZEOLITE_PATH=$(zeolite --get-path) +zeolite -p $ZEOLITE_PATH -r tests/leak-check +``` + +--- + +To check for leaks (requires [`valgrind`](https://valgrind.org/)): + +```shell +# The "leak" argument is important. +valgrind --leak-check=yes $ZEOLITE_PATH/tests/leak-check/LeakTest leak +``` + +You should get output that looks something like this: + +```text +==8487== Memcheck, a memory error detector +==8487== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al. +==8487== Using Valgrind-3.13.0 and LibVEX; rerun with -h for copyright info +==8487== Command: tests/leak-check/LeakTest leak +==8487== +==8487== +==8487== HEAP SUMMARY: +==8487== in use at exit: 2,808 bytes in 73 blocks +==8487== total heap usage: 2,488 allocs, 2,415 frees, 201,530 bytes allocated +==8487== +==8487== LEAK SUMMARY: +==8487== definitely lost: 0 bytes in 0 blocks +==8487== indirectly lost: 0 bytes in 0 blocks +==8487== possibly lost: 0 bytes in 0 blocks +==8487== still reachable: 2,808 bytes in 73 blocks +==8487== suppressed: 0 bytes in 0 blocks +==8487== Reachable blocks (those to which a pointer was found) are not shown. +==8487== To see them, rerun with: --leak-check=full --show-leak-kinds=all +==8487== +==8487== For counts of detected and suppressed errors, rerun with: -v +==8487== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 0 from 0) +``` + +*All of the `lost:` fields should be 0.* Note that `still reachable:` is normal +here; Zeolite does some static caching of data to improve performance. + +(If you happen to kill the process before it finishes then you will likely see +a lot of leaked memory, which is also normal.) + +--- + +To check for race conditions: + +```shell +# The "race" argument is important. +valgrind --leak-check=yes $ZEOLITE_PATH/tests/leak-check/LeakTest race +``` + +You should see `no race conditions this time` upon success. Any sort of error +message means a crash, and thus a test failure. diff --git a/tests/leak-check/leak-check.0rx b/tests/leak-check/leak-check.0rx new file mode 100644 --- /dev/null +++ b/tests/leak-check/leak-check.0rx @@ -0,0 +1,126 @@ +concrete LeakTest { + @type run () -> () +} + +define LeakTest { + @value Vector memory + + run () { + if (Argv.global().size() != 2) { + \ message() + } elif (Argv.global().readAt(1) == "race") { + \ runWith(1000,0) + \ LazyStream.new() + .append("no race conditions this time\n") + .writeTo(SimpleOutput.stderr()) + } elif (Argv.global().readAt(1) == "leak") { + \ runWith(100,0) + } elif (Argv.global().readAt(1) == "forever") { + \ runWith(10000000,1024*1024) + } else { + \ message() + } + } + + @type message () -> () + message () { + fail(Argv.global().readAt(0) + " [race|leak|forever]") + } + + @type runWith (Int,Int) -> () + runWith (iterations,size) { + Int threads <- Ranges:max(3,$ExprLookup[CPU_CORE_COUNT]$-1) + ReadAt barriers <- EnumeratedBarrier.new(threads+1) + traverse (Counter.zeroIndexed(iterations) -> Int i) { + \ doIteration(i,size,barriers) + \ doIteration(i,size,barriers) + } + } + + @type doIteration<#f> + #f defines ThreadFactory + (Int,Int,ReadAt) -> () + doIteration (i,size,barriers) { + \ LazyStream.new() + .append(typename<#f>()) + .append(": iteration ") + .append(i) + .append("\n") + .writeTo(SimpleOutput.stderr()) + + optional LeakTest original <- LeakTest{ Vector:createSize(size) } + + Vector threads <- Vector:create() + + traverse (Counter.zeroIndexed(barriers.size()-1) -> Int j) { + \ threads.push(ProcessThread.from(#f.create(original,barriers.readAt(j+1))).start()) + } + + \ barriers.readAt(0).wait() + original <- empty + + traverse (threads.defaultOrder() -> Thread thread) { + \ thread.join() + } + } +} + +@type interface ThreadFactory { + create (optional LeakTest,BarrierWait) -> (Routine) +} + +concrete LastReference { + defines ThreadFactory +} + +define LastReference { + $ReadOnly[copy,barrier]$ + + refines Routine + + @value weak LeakTest copy + @value BarrierWait barrier + + create (copy,barrier) { + return LastReference{ copy, barrier } + } + + run () { + \ barrier.wait() + \ strong(copy) + } +} + +concrete Chaos { + defines ThreadFactory +} + +define Chaos { + $ReadOnly[barrier]$ + + refines Routine + + @value weak LeakTest copy + @value BarrierWait barrier + + create (copy,barrier) { + return Chaos{ copy, barrier } + } + + run () { + weak LeakTest copy1 <- empty + weak LeakTest copy2 <- empty + weak LeakTest copy3 <- empty + weak LeakTest copy4 <- empty + weak LeakTest copy5 <- empty + \ barrier.wait() + copy1 <- copy + copy2 <- copy1 + copy3 <- copy1 + copy <- empty + copy4 <- strong(copy2) + copy1 <- strong(copy3) + copy2 <- empty + copy3 <- empty + } +} diff --git a/tests/module-only4/common-source.cpp b/tests/module-only4/common-source.cpp --- a/tests/module-only4/common-source.cpp +++ b/tests/module-only4/common-source.cpp @@ -29,7 +29,7 @@ namespace ZEOLITE_PRIVATE_NAMESPACE { #endif // ZEOLITE_PRIVATE_NAMESPACE -S CreateValue_Type1(S parent, const ValueTuple& args); +BoxedValue CreateValue_Type1(S parent, const ValueTuple& args); struct ExtCategory_Type1 : public Category_Type1 { }; @@ -48,12 +48,12 @@ inline ExtValue_Type1(S p, const ValueTuple& args) : Value_Type1(p), value(args.At(0)) {} - ReturnTuple Call_get(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { + ReturnTuple Call_get(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) { TRACE_FUNCTION("Type1.get") return ReturnTuple(TypeValue::Call(value, Function_Type2_get, ParamTuple(), ArgTuple())); } - const S value; + const BoxedValue value; }; Category_Type1& CreateCategory_Type1() { @@ -64,8 +64,8 @@ static const auto cached = S_get(new ExtType_Type1(CreateCategory_Type1(), Params<0>::Type())); return cached; } -S CreateValue_Type1(S parent, const ValueTuple& args) { - return S_get(new ExtValue_Type1(parent, args)); +BoxedValue CreateValue_Type1(S parent, const ValueTuple& args) { + return BoxedValue(new ExtValue_Type1(parent, args)); } #ifdef ZEOLITE_PRIVATE_NAMESPACE @@ -78,7 +78,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S CreateValue_Type3(S parent, const ValueTuple& args); +BoxedValue CreateValue_Type3(S parent, const ValueTuple& args); struct ExtCategory_Type3 : public Category_Type3 { }; @@ -97,12 +97,12 @@ inline ExtValue_Type3(S p, const ValueTuple& args) : Value_Type3(p), value(args.At(0)) {} - ReturnTuple Call_get(const S& Var_self, const ParamTuple& params, const ValueTuple& args) { + ReturnTuple Call_get(const BoxedValue& Var_self, const ParamTuple& params, const ValueTuple& args) { TRACE_FUNCTION("Type3.get") return ReturnTuple(TypeValue::Call(value, Function_Type2_get, ParamTuple(), ArgTuple())); } - const S value; + const BoxedValue value; }; Category_Type3& CreateCategory_Type3() { @@ -113,8 +113,8 @@ static const auto cached = S_get(new ExtType_Type3(CreateCategory_Type3(), Params<0>::Type())); return cached; } -S CreateValue_Type3(S parent, const ValueTuple& args) { - return S_get(new ExtValue_Type3(parent, args)); +BoxedValue CreateValue_Type3(S parent, const ValueTuple& args) { + return BoxedValue(new ExtValue_Type3(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE diff --git a/tests/simple.0rt b/tests/simple.0rt --- a/tests/simple.0rt +++ b/tests/simple.0rt @@ -124,3 +124,14 @@ unittest test { optional ModuleOnly value <- empty } + + +testcase "custom timeout works as expected" { + crash + require "signal 14" + timeout 1 +} + +unittest test { + while (true) {} +} diff --git a/tests/tracing.0rt b/tests/tracing.0rt --- a/tests/tracing.0rt +++ b/tests/tracing.0rt @@ -74,7 +74,7 @@ testcase "TraceCreation captures trace" { crash require "message" - require "Type.+created at" + require "Type.+creation" } unittest test { @@ -114,7 +114,7 @@ testcase "TraceCreation still works with NoTrace" { crash require "message" - require "Type.+created at" + require "Type.+creation" exclude "Type\.call" } @@ -142,8 +142,8 @@ testcase "TraceCreation only uses the latest" { crash require "message" - require "Type1.+created at" - exclude "Type2.+created at" + require "Type1.+creation" + exclude "Type2.+creation" } unittest test { 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.17.0.0 +version: 0.18.0.0 synopsis: Zeolite is a statically-typed, general-purpose programming language. description: @@ -36,7 +36,7 @@ . @ ZEOLITE_PATH=$(zeolite --get-path) - zeolite -p "$ZEOLITE_PATH" -f -I lib\/util -m HelloDemo example\/hello + zeolite -p "$ZEOLITE_PATH\/example\/hello" -I lib\/util --fast HelloDemo hello-demo.0rx $ZEOLITE_PATH\/example\/hello\/HelloDemo @ . @@ -130,6 +130,11 @@ tests/check-defs/.zeolite-module, tests/check-defs/*.0rp, tests/check-defs/*.0rx, + tests/fast-static/README.md, + tests/fast-static/*.0rx, + tests/leak-check/README.md, + tests/leak-check/.zeolite-module, + tests/leak-check/*.0rx, tests/module-only/README.md, tests/module-only/.zeolite-module, tests/module-only/*.0rx, @@ -300,6 +305,7 @@ containers, directory, filepath, + mtl, unix, zeolite-internal