zeolite-lang 0.17.0.0 → 0.18.0.0
raw patch · 101 files changed
+3394/−1220 lines, 101 filesdep ~mtlPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: mtl
API changes (from Hackage documentation)
- Config.LocalConfig: [ucCxxOptions] :: Backend -> [String]
- Types.Builtin: defaultCategoryDeps :: Set CategoryName
- Types.TypeCategory: guessesAsParams :: [InferredTypeGuess] -> ParamValues
+ Base.CompilerError: ifElseSuccessT :: (ErrorContextT t, Monad m, ErrorContextM (t m)) => t m a -> m () -> m () -> t m a
+ Base.TrackedErrors: data TrackedErrorsT m a
+ Cli.CompileOptions: LinkDynamic :: LinkerMode
+ Cli.CompileOptions: LinkStatic :: LinkerMode
+ Cli.CompileOptions: [cbLinker] :: CompileMode -> LinkerMode
+ Cli.CompileOptions: data LinkerMode
+ Cli.CompileOptions: instance GHC.Classes.Eq Cli.CompileOptions.LinkerMode
+ Cli.CompileOptions: instance GHC.Show.Show Cli.CompileOptions.LinkerMode
+ Cli.Programs: CompileToShared :: [FilePath] -> FilePath -> [String] -> CxxCommand
+ Cli.Programs: [ctbMacros] :: CxxCommand -> [(String, Maybe String)]
+ Cli.Programs: [ctsLinkFlags] :: CxxCommand -> [String]
+ Cli.Programs: [ctsOutput] :: CxxCommand -> FilePath
+ Cli.Programs: [ctsSources] :: CxxCommand -> [FilePath]
+ CompilerCxx.Code: hasPrimitiveValue :: CategoryName -> Bool
+ CompilerCxx.Code: integratedCategoryDeps :: Set CategoryName
+ CompilerCxx.Naming: testTimeoutMacro :: String
+ Config.LocalConfig: [ucBinaryFlags] :: Backend -> [String]
+ Config.LocalConfig: [ucCompileFlags] :: Backend -> [String]
+ Config.LocalConfig: [ucLibraryFlags] :: Backend -> [String]
+ Module.CompileMetadata: [cmLibraries] :: CompileMetadata -> [FilePath]
+ Module.CompileMetadata: getObjectFiles :: ObjectFile -> [FilePath]
+ Module.ProcessMetadata: getLibrariesForDeps :: [CompileMetadata] -> [FilePath]
+ Module.ProcessMetadata: getRecompilePath :: FilePath -> TrackedErrorsIO FilePath
+ Types.IntegrationTest: [ithTimeout] :: IntegrationTestHeader c -> Maybe Integer
+ Types.Procedure: UnambiguousLiteral :: ValueLiteral c -> ExpressionStart c
- Cli.CompileOptions: CompileBinary :: CategoryName -> FunctionName -> FilePath -> [String] -> CompileMode
+ Cli.CompileOptions: CompileBinary :: CategoryName -> FunctionName -> LinkerMode -> FilePath -> [String] -> CompileMode
- Cli.Programs: CompileToBinary :: String -> [String] -> String -> [String] -> [String] -> CxxCommand
+ Cli.Programs: CompileToBinary :: FilePath -> [FilePath] -> [(String, Maybe String)] -> FilePath -> [FilePath] -> [String] -> CxxCommand
- Cli.Programs: CompileToObject :: String -> String -> [(String, Maybe String)] -> [String] -> Bool -> CxxCommand
+ Cli.Programs: CompileToObject :: FilePath -> FilePath -> [(String, Maybe String)] -> [FilePath] -> Bool -> CxxCommand
- Cli.Programs: TestCommand :: String -> String -> [String] -> TestCommand
+ Cli.Programs: TestCommand :: FilePath -> FilePath -> [String] -> TestCommand
- Cli.Programs: [ctbMain] :: CxxCommand -> String
+ Cli.Programs: [ctbMain] :: CxxCommand -> FilePath
- Cli.Programs: [ctbOutput] :: CxxCommand -> String
+ Cli.Programs: [ctbOutput] :: CxxCommand -> FilePath
- Cli.Programs: [ctbPaths] :: CxxCommand -> [String]
+ Cli.Programs: [ctbPaths] :: CxxCommand -> [FilePath]
- Cli.Programs: [ctbSources] :: CxxCommand -> [String]
+ Cli.Programs: [ctbSources] :: CxxCommand -> [FilePath]
- Cli.Programs: [ctoPath] :: CxxCommand -> String
+ Cli.Programs: [ctoPath] :: CxxCommand -> FilePath
- Cli.Programs: [ctoPaths] :: CxxCommand -> [String]
+ Cli.Programs: [ctoPaths] :: CxxCommand -> [FilePath]
- Cli.Programs: [ctoSource] :: CxxCommand -> String
+ Cli.Programs: [ctoSource] :: CxxCommand -> FilePath
- Cli.Programs: [tcBinary] :: TestCommand -> String
+ Cli.Programs: [tcBinary] :: TestCommand -> FilePath
- Cli.Programs: [tcPath] :: TestCommand -> String
+ Cli.Programs: [tcPath] :: TestCommand -> FilePath
- Cli.Programs: runCxxCommand :: (CompilerBackend b, MonadIO m, ErrorContextM m) => b -> CxxCommand -> m String
+ Cli.Programs: runCxxCommand :: (CompilerBackend b, MonadIO m, ErrorContextM m) => b -> CxxCommand -> m FilePath
- Cli.TestRunner: runSingleTest :: CompilerBackend b => b -> FilePath -> LanguageModule SourceContext -> FilePath -> [FilePath] -> [CompileMetadata] -> (String, String) -> TrackedErrorsIO ((Int, Int), TrackedErrors ())
+ Cli.TestRunner: runSingleTest :: CompilerBackend b => b -> FilePath -> LanguageModule SourceContext -> [FilePath] -> [CompileMetadata] -> (String, String) -> TrackedErrorsIO ((Int, Int), TrackedErrors ())
- Config.LocalConfig: UnixBackend :: FilePath -> [String] -> FilePath -> Backend
+ Config.LocalConfig: UnixBackend :: FilePath -> [String] -> [String] -> [String] -> FilePath -> Backend
- Module.CompileMetadata: CompileMetadata :: VersionHash -> FilePath -> Namespace -> Namespace -> [FilePath] -> [FilePath] -> [CategoryName] -> [CategoryName] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [ObjectFile] -> CompileMetadata
+ Module.CompileMetadata: CompileMetadata :: VersionHash -> FilePath -> Namespace -> Namespace -> [FilePath] -> [FilePath] -> [CategoryName] -> [CategoryName] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [ObjectFile] -> CompileMetadata
- Types.IntegrationTest: IntegrationTestHeader :: [c] -> String -> [String] -> ExpectedResult c -> IntegrationTestHeader c
+ Types.IntegrationTest: IntegrationTestHeader :: [c] -> String -> [String] -> Maybe Integer -> ExpectedResult c -> IntegrationTestHeader c
- Types.Procedure: InitializeValue :: [c] -> Maybe TypeInstance -> Positional (Expression c) -> Expression c
+ Types.Procedure: InitializeValue :: [c] -> Maybe TypeInstance -> Positional (Expression c) -> ExpressionStart c
- Types.TypeCategory: mergeInferredTypes :: (CollectErrorsM m, TypeResolver r) => r -> ParamFilters -> ParamFilters -> ParamValues -> MergeTree InferredTypeGuess -> m [InferredTypeGuess]
+ Types.TypeCategory: mergeInferredTypes :: (CollectErrorsM m, TypeResolver r) => r -> ParamFilters -> ParamFilters -> ParamValues -> MergeTree InferredTypeGuess -> m ParamValues
Files
- ChangeLog.md +104/−0
- base/.zeolite-module +2/−0
- base/boxed.hpp +134/−0
- base/builtin.0rp +38/−2
- base/category-header.hpp +0/−1
- base/category-source.hpp +47/−37
- base/function.hpp +2/−0
- base/internal.hpp +0/−25
- base/logging.hpp +0/−5
- base/pooled.hpp +14/−4
- base/src/Extension_Bool.cpp +16/−25
- base/src/Extension_Char.cpp +30/−27
- base/src/Extension_CharBuffer.cpp +12/−12
- base/src/Extension_Float.cpp +18/−24
- base/src/Extension_Int.cpp +31/−27
- base/src/Extension_String.cpp +26/−26
- base/src/boxed.cpp +420/−0
- base/src/category-source.cpp +8/−62
- base/src/logging.cpp +3/−4
- base/src/types.cpp +76/−101
- base/types.hpp +57/−63
- bin/zeolite-setup.hs +14/−8
- bin/zeolite.hs +11/−0
- example/hello/README.md +1/−1
- example/primes/README.md +0/−8
- lib/container/sequence.0rp +18/−0
- lib/container/sequence.0rt +18/−0
- lib/container/sequence.0rx +71/−0
- lib/container/sorting.0rx +4/−4
- lib/container/src/Extension_Vector.cpp +25/−24
- lib/file/src/Extension_RawFileReader.cpp +9/−9
- lib/file/src/Extension_RawFileWriter.cpp +8/−8
- lib/file/tests.0rt +2/−2
- lib/math/categorical-tree.0rp +4/−3
- lib/math/src/Extension_Math.cpp +29/−29
- lib/thread/README.md +8/−20
- lib/thread/src/Extension_Enumerated.cpp +18/−17
- lib/thread/src/Extension_ProcessThread.cpp +9/−8
- lib/thread/src/Extension_Realtime.cpp +14/−1
- lib/thread/src/Extension_ThreadCondition.cpp +10/−10
- lib/thread/testing.0rx +4/−2
- lib/thread/thread.0rp +1/−1
- lib/thread/time.0rp +9/−0
- lib/thread/time.0rt +24/−0
- lib/util/helpers.0rt +22/−22
- lib/util/input.0rt +10/−0
- lib/util/parse.0rp +131/−0
- lib/util/parse.0rt +221/−0
- lib/util/parse.0rx +299/−0
- lib/util/src/Extension_Argv.cpp +12/−12
- lib/util/src/Extension_MutexLock.cpp +12/−11
- lib/util/src/Extension_SimpleInput.cpp +5/−5
- lib/util/src/Extension_SimpleMutex.cpp +5/−5
- lib/util/src/Extension_SimpleOutput.cpp +10/−10
- lib/util/testing.0rp +50/−0
- lib/util/testing.0rt +96/−0
- lib/util/testing.0rx +58/−0
- src/Base/CompilerError.hs +1/−0
- src/Base/TrackedErrors.hs +27/−20
- src/Cli/CompileOptions.hs +9/−5
- src/Cli/Compiler.hs +44/−27
- src/Cli/ParseCompileOptions.hs +44/−23
- src/Cli/Programs.hs +16/−10
- src/Cli/RunCompiler.hs +58/−56
- src/Cli/TestRunner.hs +53/−30
- src/CompilerCxx/Code.hs +37/−25
- src/CompilerCxx/CxxFiles.hs +49/−23
- src/CompilerCxx/Naming.hs +4/−0
- src/CompilerCxx/Procedure.hs +91/−83
- src/Config/LocalConfig.hs +33/−23
- src/Module/CompileMetadata.hs +6/−0
- src/Module/ParseMetadata.hs +22/−6
- src/Module/ProcessMetadata.hs +13/−2
- src/Parser/Common.hs +4/−4
- src/Parser/IntegrationTest.hs +16/−10
- src/Parser/Procedure.hs +32/−27
- src/Test/IntegrationTest.hs +8/−1
- src/Test/ParseMetadata.hs +21/−1
- src/Test/Procedure.hs +12/−4
- src/Test/TrackedErrors.hs +31/−1
- src/Test/TypeCategory.hs +5/−5
- src/Test/testfiles/basic_crash_test.0rt +2/−0
- src/Test/testfiles/basic_success_test.0rt +1/−0
- src/Test/testfiles/function_filter_type_param.0rx +11/−0
- src/Test/testfiles/module-cache.txt +4/−0
- src/Types/Builtin.hs +0/−5
- src/Types/IntegrationTest.hs +1/−0
- src/Types/Procedure.hs +3/−3
- src/Types/TypeCategory.hs +40/−42
- tests/builtin-types.0rt +66/−59
- tests/cli-tests.sh +38/−33
- tests/fast-static/README.md +18/−0
- tests/fast-static/program.0rx +12/−0
- tests/inference.0rt +41/−11
- tests/leak-check/.zeolite-module +17/−0
- tests/leak-check/README.md +65/−0
- tests/leak-check/leak-check.0rx +126/−0
- tests/module-only4/common-source.cpp +10/−10
- tests/simple.0rt +11/−0
- tests/tracing.0rt +4/−4
- zeolite-lang.cabal +8/−2
ChangeLog.md view
@@ -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<TypeValue>` must be replaced with `BoxedValue`.+ - Calls to `S_get` (only for `ValueType`) must be replaced with calls to the+ `BoxedValue` constructor.+ - `W<TypeValue>` 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
base/.zeolite-module view
@@ -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"
+ base/boxed.hpp view
@@ -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 <atomic>++#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_
base/builtin.0rp view
@@ -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<Bool> } -// 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<Char> defines LessThan<Char>@@ -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<Int> defines LessThan<Int>@@ -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<Char>@@ -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.
base/category-header.hpp view
@@ -26,7 +26,6 @@ class TypeCategory; class TypeInstance;-class TypeValue; class CategoryFunction; class TypeFunction; class ValueFunction;
base/category-source.hpp view
@@ -24,13 +24,15 @@ #include <sstream> #include <vector> +#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<TypeValue>& Var_empty;--S<TypeValue> Box_Bool(bool value);-S<TypeValue> Box_String(const PrimString& value);-S<TypeValue> Box_Char(PrimChar value);-S<TypeValue> Box_Int(PrimInt value);-S<TypeValue> 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<TypeInstance> Merge_Intersect(L<S<const TypeInstance>> params); S<TypeInstance> Merge_Union(L<S<const TypeInstance>> params);@@ -53,14 +53,14 @@ const S<TypeInstance>& GetMerged_Any(); const S<TypeInstance>& GetMerged_All(); -extern const S<TypeValue>& 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<TypeValue> Reduce(const S<const TypeInstance>& from,- const S<const TypeInstance>& to, S<TypeValue> target) {+ static BoxedValue Reduce(const S<const TypeInstance>& from,+ const S<const TypeInstance>& 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<TypeValue>& 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<TypeValue> target);- static S<TypeValue> Require(S<TypeValue> target);- static S<TypeValue> Strong(W<TypeValue> 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<TypeValue>& 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<TypeValue> cont,+ AnonymousOrder(const BoxedValue cont, const ValueFunction& func_next, const ValueFunction& func_get); std::string CategoryName() const final;- ReturnTuple Dispatch(const S<TypeValue>& 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<TypeValue> Call_next(const S<TypeValue>& self) = 0;- virtual S<TypeValue> Call_get(const S<TypeValue>& self) = 0;+ virtual BoxedValue Call_next(const BoxedValue& self) = 0;+ virtual BoxedValue Call_get(const BoxedValue& self) = 0; - const S<TypeValue> container;+ const BoxedValue container; const ValueFunction& function_next; const ValueFunction& function_get;+};++template <int P, class T>+class InstanceCache {+ public:+ using Creator = std::function<S<T>(typename Params<P>::Type)>;++ InstanceCache(const Creator& create) : create_(create) {}++ S<T> GetOrCreate(typename Params<P>::Type params) {+ while (lock_.test_and_set(std::memory_order_acquire));+ auto& cached = cache_[GetKeyFromParams<P>(params)];+ S<T> 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<typename ParamsKey<P>::Type, S<T>> cache_; }; #endif // CATEGORY_SOURCE_HPP_
base/function.hpp view
@@ -21,6 +21,8 @@ #include <ostream> +#include "types.hpp"+ struct CategoryFunction { const int param_count;
base/internal.hpp view
@@ -23,34 +23,9 @@ #include <atomic> #include "category-source.hpp"-#include "cycle-check.hpp" #define COLLECTION_ID(vp) (int) 1000000009 * (long) (vp)--template <int P, class T>-class InstanceCache {- public:- using Creator = std::function<S<T>(typename Params<P>::Type)>;-- InstanceCache(const Creator& create) : create_(create) {}-- S<T> GetOrCreate(typename Params<P>::Type params) {- while (lock_.test_and_set(std::memory_order_acquire));- auto& cached = cache_[GetKeyFromParams<P>(params)];- S<T> 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<typename ParamsKey<P>::Type, S<T>> cache_;-}; template<class F> struct DispatchTable {
base/logging.hpp view
@@ -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
base/pooled.hpp view
@@ -20,9 +20,17 @@ #define POOLED_HPP_ +class ArgTuple;+class ReturnTuple;+class ParamTuple;++namespace zeolite_internal {+ template<class T> class PoolStorage { public:+ using Managed = T;+ inline T* data() const { return (T*) (this + 1); }@@ -48,9 +56,9 @@ template<class T> 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<class...Ts> 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<T>* array_; };++} // namespace zeolite_internal #endif // POOLED_HPP_
base/src/Extension_Bool.cpp view
@@ -46,42 +46,33 @@ ReturnTuple Call_equals(const S<TypeInstance>& 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<Type_Bool> p, bool value) : Value_Bool(p), value_(value) {}-- ReturnTuple Call_asBool(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& Var_true = *new S<TypeValue>(new ExtValue_Bool(CreateType_Bool(Params<0>::Type()), true));-const S<TypeValue>& Var_false = *new S<TypeValue>(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<TypeValue> Box_Bool(bool value) {- return value? Var_true : Var_false;+BoxedValue Box_Bool(bool value) {+ return BoxedValue(value); }
base/src/Extension_Char.cpp view
@@ -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<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Char.maxBound")+ return ReturnTuple(Box_Char('\xff'));+ }++ ReturnTuple Call_minBound(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Char.minBound")+ return ReturnTuple(Box_Char('\0'));+ }+ ReturnTuple Call_default(const S<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<Var_arg2)); } }; -struct ExtValue_Char : public Value_Char {- inline ExtValue_Char(S<Type_Char> p, PrimChar value) : Value_Char(p), value_(value) {}-- ReturnTuple Call_asBool(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue> Box_Char(PrimChar value) {- return S_get(new ExtValue_Char(CreateType_Char(Params<0>::Type()), value));+BoxedValue Box_Char(PrimChar value) {+ return BoxedValue(value); }
base/src/Extension_CharBuffer.cpp view
@@ -29,7 +29,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_CharBuffer(S<Type_CharBuffer> parent, PrimCharBuffer buffer);+BoxedValue CreateValue_CharBuffer(S<Type_CharBuffer> parent, PrimCharBuffer buffer); struct ExtCategory_CharBuffer : public Category_CharBuffer { };@@ -39,7 +39,7 @@ ReturnTuple Call_new(const S<TypeInstance>& 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<Type_CharBuffer> p, PrimCharBuffer value) : Value_CharBuffer(p), value_(std::move(value)) {} - ReturnTuple Call_readAt(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue> CreateValue_CharBuffer(S<Type_CharBuffer> parent, PrimCharBuffer value) {- return S_get(new ExtValue_CharBuffer(parent, std::move(value)));+BoxedValue CreateValue_CharBuffer(S<Type_CharBuffer> parent, PrimCharBuffer value) {+ return BoxedValue(new ExtValue_CharBuffer(parent, std::move(value))); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
base/src/Extension_Float.cpp view
@@ -49,48 +49,42 @@ ReturnTuple Call_equals(const S<TypeInstance>& 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<TypeInstance>& 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<Var_arg2)); } }; -struct ExtValue_Float : public Value_Float {- inline ExtValue_Float(S<Type_Float> p, PrimFloat value) : Value_Float(p), value_(value) {}-- ReturnTuple Call_asBool(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue> Box_Float(PrimFloat value) {- return S_get(new ExtValue_Float(CreateType_Float(Params<0>::Type()), value));+BoxedValue Box_Float(PrimFloat value) {+ return BoxedValue(value); }
base/src/Extension_Int.cpp view
@@ -16,6 +16,7 @@ // Author: Kevin P. Barry [ta0kira@gmail.com] +#include <climits> #include <sstream> #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<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Int.maxBound")+ return ReturnTuple(Box_Int(9223372036854775807LL));+ }++ ReturnTuple Call_minBound(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Int.minBound")+ return ReturnTuple(Box_Int(-9223372036854775807LL - 1LL));+ }+ ReturnTuple Call_default(const S<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<Var_arg2)); } }; -struct ExtValue_Int : public Value_Int {- inline ExtValue_Int(S<Type_Int> p, PrimInt value) : Value_Int(p), value_(value) {}-- ReturnTuple Call_asBool(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue> Box_Int(PrimInt value) {- return S_get(new ExtValue_Int(CreateType_Int(Params<0>::Type()), value));+BoxedValue Box_Int(PrimInt value) {+ return BoxedValue(value); }
base/src/Extension_String.cpp view
@@ -47,7 +47,7 @@ public: std::string CategoryName() const final { return "StringBuilder"; } - ReturnTuple Dispatch(const S<TypeValue>& 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<std::mutex> 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<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.builder")- return ReturnTuple(S<TypeValue>(new Value_StringBuilder));+ return ReturnTuple(BoxedValue(new Value_StringBuilder)); } ReturnTuple Call_default(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {@@ -90,30 +90,30 @@ ReturnTuple Call_equals(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.equals")- const S<TypeValue>& Var_arg1 = (args.At(0));- const S<TypeValue>& 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<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.fromCharBuffer")- const S<TypeValue>& 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<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final { TRACE_FUNCTION("String.lessThan")- const S<TypeValue>& Var_arg1 = (args.At(0));- const S<TypeValue>& 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())); } }; struct StringOrder : public AnonymousOrder {- StringOrder(S<TypeValue> container, const std::string& s)+ StringOrder(BoxedValue container, const std::string& s) : AnonymousOrder(container, Function_Order_next, Function_Order_get), value(s) {} - S<TypeValue> Call_next(const S<TypeValue>& self) final {+ BoxedValue Call_next(const BoxedValue& self) final { if (index+1 >= value.size()) { return Var_empty; } else {@@ -122,7 +122,7 @@ } } - S<TypeValue> Call_get(const S<TypeValue>& 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<Type_String> p, const PrimString& value) : Value_String(p), value_(value) {} - ReturnTuple Call_asBool(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue> 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)); }
+ base/src/boxed.cpp view
@@ -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 <climits>++#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;+}
base/src/category-source.cpp view
@@ -25,19 +25,6 @@ namespace { -struct OptionalEmpty : public TypeValue {- ReturnTuple Dispatch(const S<TypeValue>& 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<S<const TypeInstance>> params) : params_(params.begin(), params.end()) {} @@ -134,8 +121,7 @@ return instance; } --const S<TypeValue>& Var_empty = *new S<TypeValue>(new OptionalEmpty());+const BoxedValue Var_empty; ReturnTuple TypeCategory::Dispatch(const CategoryFunction& label,@@ -150,7 +136,7 @@ __builtin_unreachable(); } -ReturnTuple TypeValue::Dispatch(const S<TypeValue>& 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<TypeValue> target) {- if (target == nullptr) {- FAIL() << "Builtin called on null value";- }- return target->Present();-}--S<TypeValue> TypeValue::Require(S<TypeValue> target) {- if (target == nullptr) {- FAIL() << "Builtin called on null value";- }- if (!target->Present()) {- FAIL() << "Cannot require empty value";- }- return target;-}--S<TypeValue> TypeValue::Strong(W<TypeValue> 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<TypeValue> 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<TypeValue>& self, const ValueFunction& label,+ const BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) { if (&label == &function_next) { TRACE_FUNCTION("AnonymousOrder.next")
base/src/logging.cpp view
@@ -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 <cassert> #include <chrono> #include <csignal> #include <iomanip>@@ -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_);
base/src/types.cpp view
@@ -20,6 +20,7 @@ #include <atomic> +#include "boxed.hpp" #include "logging.hpp" @@ -27,14 +28,14 @@ return size_; } -const S<TypeValue>& 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<TypeValue>& ArgTuple::Only() const {+const BoxedValue& ArgTuple::Only() const { if (size_ != 1) { FAIL() << "Bad ArgTuple index"; }@@ -56,21 +57,21 @@ return size_; } -S<TypeValue>& ReturnTuple::At(int pos) {+BoxedValue& ReturnTuple::At(int pos) { if (pos < 0 || pos >= size_) { FAIL() << "Bad ReturnTuple index"; } return data_[pos]; } -const S<TypeValue>& 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<TypeValue>& ReturnTuple::Only() const {+const BoxedValue& ReturnTuple::Only() const { if (size_ != 1) { FAIL() << "Bad ReturnTuple index"; }@@ -89,149 +90,130 @@ } -template<class T>-class PoolCleanup {- public:- constexpr PoolCleanup() {}+namespace { - ~PoolCleanup() {- PoolManager<T>::Purge();+template<class P>+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<class P>+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<PoolStorage<S<TypeValue>>*> return_tuple_pool4_{nullptr};+unsigned int PoolManager<BoxedValue>::pool4_size_ = 0;+typename PoolManager<BoxedValue>::PoolEntry* PoolManager<BoxedValue>::pool4_{nullptr};+std::atomic_flag PoolManager<BoxedValue>::pool4_flag_ = ATOMIC_FLAG_INIT; // static-PoolStorage<S<TypeValue>>* PoolManager<S<TypeValue>>::Take(int size) {+typename PoolManager<BoxedValue>::PoolEntry* PoolManager<BoxedValue>::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<S<TypeValue>>::Return(PoolEntry* storage) {+void PoolManager<BoxedValue>::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<PoolStorage<const S<TypeValue>*>*> arg_tuple_pool4_{nullptr};+unsigned int PoolManager<const BoxedValue*>::pool4_size_ = 0;+typename PoolManager<const BoxedValue*>::PoolEntry* PoolManager<const BoxedValue*>::pool4_{nullptr};+std::atomic_flag PoolManager<const BoxedValue*>::pool4_flag_ = ATOMIC_FLAG_INIT; // static-PoolStorage<const S<TypeValue>*>* PoolManager<const S<TypeValue>*>::Take(int size) {+typename PoolManager<const BoxedValue*>::PoolEntry* PoolManager<const BoxedValue*>::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<const S<TypeValue>*>::Return(PoolEntry* storage) {+void PoolManager<const BoxedValue*>::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<PoolStorage<S<TypeInstance>>*> param_tuple_pool4_{nullptr};+unsigned int PoolManager<S<TypeInstance>>::pool4_size_ = 0;+typename PoolManager<S<TypeInstance>>::PoolEntry* PoolManager<S<TypeInstance>>::pool4_{nullptr};+std::atomic_flag PoolManager<S<TypeInstance>>::pool4_flag_ = ATOMIC_FLAG_INIT; // static-PoolStorage<S<TypeInstance>>* PoolManager<S<TypeInstance>>::Take(int size) {+typename PoolManager<S<TypeInstance>>::PoolEntry* PoolManager<S<TypeInstance>>::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
base/types.hpp view
@@ -19,6 +19,7 @@ #ifndef TYPES_HPP_ #define TYPES_HPP_ +#include <atomic> #include <cstdint> #include <functional> #include <memory>@@ -60,12 +61,6 @@ template<class T> inline S<T> S_get(T* val) { return S<T>(val); } -template<class T>-using W = std::weak_ptr<T>;--template<class T>-inline W<T> W_get(T* val) { return W<T>(val); }- template<class...Ts> using T = std::tuple<Ts...>; @@ -122,6 +117,8 @@ class TypeCategory; class TypeInstance; class TypeValue;+class BoxedValue;+class WeakValue; template<int N, class...Ts> struct Params {@@ -165,8 +162,8 @@ class ValueTuple { public: virtual int Size() const = 0;- virtual const S<TypeValue>& At(int pos) const = 0;- virtual const S<TypeValue>& 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<S<TypeValue>> {- using Managed = S<TypeValue>;- using PoolEntry = PoolStorage<Managed>;+class PoolManager<BoxedValue> {+ using PoolEntry = PoolStorage<BoxedValue>;+ using Managed = PoolEntry::Managed; template<class> 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<const BoxedValue*> {+ using PoolEntry = PoolStorage<const BoxedValue*>;+ using Managed = PoolEntry::Managed;++ template<class> 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<S<TypeInstance>> {+ using PoolEntry = PoolStorage<S<TypeInstance>>;+ using Managed = PoolEntry::Managed;++ template<class> 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<TypeValue>& At(int pos);- const S<TypeValue>& At(int pos) const final;- const S<TypeValue>& 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<S<TypeValue>> data_;-};--template<>-class PoolManager<const S<TypeValue>*> {- using Managed = const S<TypeValue>*;- using PoolEntry = PoolStorage<Managed>;-- template<class> friend class PoolArray;-- static PoolEntry* Take(int size);- static void Return(PoolEntry* storage);-- static constexpr unsigned int pool_limit_ = 256;+ zeolite_internal::PoolArray<BoxedValue> data_; }; class ArgTuple : public ValueTuple {@@ -236,8 +261,8 @@ } int Size() const final;- const S<TypeValue>& At(int pos) const final;- const S<TypeValue>& 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<const S<TypeValue>*> data_;-};--template<>-class PoolManager<S<TypeInstance>> {- using Managed = S<TypeInstance>;- using PoolEntry = PoolStorage<Managed>;-- template<class> friend class PoolArray;-- static PoolEntry* Take(int size);- static void Return(PoolEntry* storage);-- static constexpr unsigned int pool_limit_ = 256;+ zeolite_internal::PoolArray<const BoxedValue*> data_; }; class ParamTuple {@@ -282,25 +294,7 @@ void* operator new(std::size_t size) = delete; int size_;- PoolArray<S<TypeInstance>> data_;+ zeolite_internal::PoolArray<S<TypeInstance>> 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_
bin/zeolite-setup.hs view
@@ -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,
bin/zeolite.hs view
@@ -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
example/hello/README.md view
@@ -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
example/primes/README.md view
@@ -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
+ lib/container/sequence.0rp view
@@ -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]+
+ lib/container/sequence.0rt view
@@ -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]+
+ lib/container/sequence.0rx view
@@ -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)+++}
lib/container/sorting.0rx view
@@ -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))
lib/container/src/Extension_Vector.cpp view
@@ -36,17 +36,17 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -using VectorType = std::vector<S<TypeValue>>;+using VectorType = std::vector<BoxedValue>; -S<TypeValue> CreateValue_Vector(S<Type_Vector> parent, VectorType values);+BoxedValue CreateValue_Vector(S<Type_Vector> 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<TypeInstance> Param_y = params.At(0);- const S<TypeValue>& 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<TypeInstance> 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<TypeValue> container, const VectorType& v)+ VectorOrder(BoxedValue container, const VectorType& v) : AnonymousOrder(container, Function_Order_next, Function_Order_get), values(v) {} - S<TypeValue> Call_next(const S<TypeValue>& self) final {+ BoxedValue Call_next(const BoxedValue& self) final { if (index+1 >= values.size()) { return Var_empty; } else {@@ -88,7 +88,7 @@ } } - S<TypeValue> Call_get(const S<TypeValue>& 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<Type_Vector> p, VectorType v) : Value_Vector(p), values(std::move(v)) {} - ReturnTuple Call_append(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue> value = values.back();+ BoxedValue value = values.back(); values.pop_back(); return ReturnTuple(value); } - ReturnTuple Call_push(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue> CreateValue_Vector(S<Type_Vector> parent, VectorType values) {- return S_get(new ExtValue_Vector(parent, values));+BoxedValue CreateValue_Vector(S<Type_Vector> parent, VectorType values) {+ return BoxedValue(new ExtValue_Vector(parent, values)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/file/src/Extension_RawFileReader.cpp view
@@ -25,7 +25,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ValueTuple& args);+BoxedValue CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ValueTuple& args); struct ExtCategory_RawFileReader : public Category_RawFileReader { };@@ -42,10 +42,10 @@ struct ExtValue_RawFileReader : public Value_RawFileReader { inline ExtValue_RawFileReader(S<Type_RawFileReader> 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<TypeValue>& 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<std::mutex> lock(mutex); if (file) {@@ -54,7 +54,7 @@ return ReturnTuple(); } - ReturnTuple Call_getFileError(const S<TypeValue>& 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<std::mutex> lock(mutex); if (!file) {@@ -69,17 +69,17 @@ return ReturnTuple(Var_empty); } - ReturnTuple Call_pastEnd(const S<TypeValue>& 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<std::mutex> lock(mutex); return ReturnTuple(Box_Bool(!file || file->fail() || file->eof())); } - ReturnTuple Call_readBlock(const S<TypeValue>& 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<std::mutex> 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<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ValueTuple& args) {- return S_get(new ExtValue_RawFileReader(parent, args));+BoxedValue CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ValueTuple& args) {+ return BoxedValue(new ExtValue_RawFileReader(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/file/src/Extension_RawFileWriter.cpp view
@@ -25,7 +25,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ValueTuple& args);+BoxedValue CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ValueTuple& args); struct ExtCategory_RawFileWriter : public Category_RawFileWriter { };@@ -42,10 +42,10 @@ struct ExtValue_RawFileWriter : public Value_RawFileWriter { inline ExtValue_RawFileWriter(S<Type_RawFileWriter> 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<TypeValue>& 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<std::mutex> lock(mutex); if (file) {@@ -54,7 +54,7 @@ return ReturnTuple(); } - ReturnTuple Call_getFileError(const S<TypeValue>& 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<std::mutex> lock(mutex); if (!file) {@@ -69,11 +69,11 @@ return ReturnTuple(Var_empty); } - ReturnTuple Call_writeBlock(const S<TypeValue>& 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<std::mutex> 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<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ValueTuple& args) {- return S_get(new ExtValue_RawFileWriter(parent, args));+BoxedValue CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ValueTuple& args) {+ return BoxedValue(new ExtValue_RawFileWriter(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/file/tests.0rt view
@@ -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 {
lib/math/categorical-tree.0rp view
@@ -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
lib/math/src/Extension_Math.cpp view
@@ -35,165 +35,165 @@ ReturnTuple Call_acos(const S<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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<TypeInstance>& 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))); } };
lib/thread/README.md view
@@ -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+```
lib/thread/src/Extension_Enumerated.cpp view
@@ -101,7 +101,7 @@ namespace ZEOLITE_PRIVATE_NAMESPACE { #endif // ZEOLITE_PRIVATE_NAMESPACE -S<TypeValue> CreateValue_EnumeratedWait(+BoxedValue CreateValue_EnumeratedWait( S<Type_EnumeratedWait> parent, S<Barrier> b, int i); struct ExtCategory_EnumeratedWait : public Category_EnumeratedWait {@@ -115,7 +115,7 @@ inline ExtValue_EnumeratedWait(S<Type_EnumeratedWait> p, S<Barrier> b, int i) : Value_EnumeratedWait(p), barrier(b), index(i) {} - ReturnTuple Call_wait(const S<TypeValue>& 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<TypeValue> CreateValue_EnumeratedWait(+BoxedValue CreateValue_EnumeratedWait( S<Type_EnumeratedWait> parent, S<Barrier> 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<TypeValue> CreateValue_EnumeratedBarrier(- S<Type_EnumeratedBarrier> parent, std::vector<S<TypeValue>> w);+BoxedValue CreateValue_EnumeratedBarrier(+ S<Type_EnumeratedBarrier> parent, std::vector<BoxedValue> w); struct ExtCategory_EnumeratedBarrier : public Category_EnumeratedBarrier { };@@ -163,14 +163,14 @@ ReturnTuple Call_new(const S<TypeInstance>& 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<S<TypeValue>> waits;+ std::vector<BoxedValue> waits; S<Barrier> barrier(Var_arg1? new Barrier(Var_arg1) : nullptr); for (int i = 0; i < Var_arg1; ++i) {- S<TypeValue> 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<Type_EnumeratedBarrier> p, std::vector<S<TypeValue>> w)+ inline ExtValue_EnumeratedBarrier(S<Type_EnumeratedBarrier> p, std::vector<BoxedValue> w) : Value_EnumeratedBarrier(p), waits(std::move(w)) {} - ReturnTuple Call_readAt(const S<TypeValue>& 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<TypeValue>& 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<S<TypeValue>> waits;+ // vector<BarrierWait>+ const std::vector<BoxedValue> 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<TypeValue> CreateValue_EnumeratedBarrier(- S<Type_EnumeratedBarrier> parent, std::vector<S<TypeValue>> w) {- return S_get(new ExtValue_EnumeratedBarrier(parent, std::move(w)));+BoxedValue CreateValue_EnumeratedBarrier(+ S<Type_EnumeratedBarrier> parent, std::vector<BoxedValue> w) {+ return BoxedValue(new ExtValue_EnumeratedBarrier(parent, std::move(w))); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/thread/src/Extension_ProcessThread.cpp view
@@ -31,7 +31,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_ProcessThread(S<Type_ProcessThread> parent, const ValueTuple& args);+BoxedValue CreateValue_ProcessThread(S<Type_ProcessThread> parent, const ValueTuple& args); struct ExtCategory_ProcessThread : public Category_ProcessThread { };@@ -49,7 +49,7 @@ inline ExtValue_ProcessThread(S<Type_ProcessThread> p, const ValueTuple& args) : Value_ProcessThread(p), routine(args.Only()) {} - ReturnTuple Call_detach(const S<TypeValue>& 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<std::thread> temp = thread; thread = nullptr;@@ -61,12 +61,12 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_isRunning(const S<TypeValue>& 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<TypeValue>& 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<std::thread> temp = thread; thread = nullptr;@@ -78,7 +78,7 @@ return ReturnTuple(Var_self); } - ReturnTuple Call_start(const S<TypeValue>& 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<TypeValue> routine;+ // Routine+ const BoxedValue routine; S<std::thread> 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<TypeValue> CreateValue_ProcessThread(S<Type_ProcessThread> parent, const ValueTuple& args) {- return S_get(new ExtValue_ProcessThread(parent, args));+BoxedValue CreateValue_ProcessThread(S<Type_ProcessThread> parent, const ValueTuple& args) {+ return BoxedValue(new ExtValue_ProcessThread(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/thread/src/Extension_Realtime.cpp view
@@ -21,6 +21,9 @@ #include <string.h> #include <time.h> +#include <chrono>+#include <iomanip>+ #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<TypeInstance>& 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<TypeInstance>& 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<std::chrono::microseconds>(time).count() /+ (PrimFloat) 1000000.0;+ return ReturnTuple(Box_Float(seconds)); } };
lib/thread/src/Extension_ThreadCondition.cpp view
@@ -32,7 +32,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_ThreadCondition(S<Type_ThreadCondition> parent);+BoxedValue CreateValue_ThreadCondition(S<Type_ThreadCondition> parent); struct ExtCategory_ThreadCondition : public Category_ThreadCondition { };@@ -56,7 +56,7 @@ pthread_mutex_init(&mutex, &mutex_attr); } - ReturnTuple Call_lock(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue> CreateValue_ThreadCondition(S<Type_ThreadCondition> parent) {- return S_get(new ExtValue_ThreadCondition(parent));+BoxedValue CreateValue_ThreadCondition(S<Type_ThreadCondition> parent) {+ return BoxedValue(new ExtValue_ThreadCondition(parent)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/thread/testing.0rx view
@@ -31,8 +31,10 @@ return InfiniteRoutine{ } } - run () {- while (true) {}+ run () { $NoTrace$+ while (true) {+ \ Realtime.sleepSeconds(60.0)+ } } }
lib/thread/thread.0rp view
@@ -82,7 +82,7 @@ // @value weak Thread thread // // createAndRun () {- // return (MyRoutine{ empty }).start()+ // return MyRoutine{ empty }.start() // } // // run () {
lib/thread/time.0rp view
@@ -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) }
lib/thread/time.0rt view
@@ -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)+}
lib/util/helpers.0rt view
@@ -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<?,Reversed<Char>>` ("").defaultOrder(), false)- \ Testing.checkEquals<?>(("a").defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` ("abc").defaultOrder(),true)- \ Testing.checkEquals<?>(("b").defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` ("abc").defaultOrder(),true)- \ Testing.checkEquals<?>(("abc").defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` ("abc").defaultOrder(),false)- \ Testing.checkEquals<?>(("abc").defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` ("a").defaultOrder(), false)- \ Testing.checkEquals<?>(("abc").defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` ("b").defaultOrder(), false)+ \ Testing.checkEquals<?>("".defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` "".defaultOrder(), false)+ \ Testing.checkEquals<?>("a".defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` "abc".defaultOrder(),true)+ \ Testing.checkEquals<?>("b".defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` "abc".defaultOrder(),true)+ \ Testing.checkEquals<?>("abc".defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` "abc".defaultOrder(),false)+ \ Testing.checkEquals<?>("abc".defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` "a".defaultOrder(), false)+ \ Testing.checkEquals<?>("abc".defaultOrder() `OrderH:lessThanWith<?,Reversed<Char>>` "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<?,IgnoreCase>` ("").defaultOrder(), true)- \ Testing.checkEquals<?>(("a").defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` ("ABC").defaultOrder(),false)- \ Testing.checkEquals<?>(("abc").defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` ("ABC").defaultOrder(),true)- \ Testing.checkEquals<?>(("abc").defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` ("DEF").defaultOrder(),false)- \ Testing.checkEquals<?>(("abc").defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` ("A").defaultOrder(), false)+ \ Testing.checkEquals<?>("".defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` "".defaultOrder(), true)+ \ Testing.checkEquals<?>("a".defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` "ABC".defaultOrder(),false)+ \ Testing.checkEquals<?>("abc".defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` "ABC".defaultOrder(),true)+ \ Testing.checkEquals<?>("abc".defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` "DEF".defaultOrder(),false)+ \ Testing.checkEquals<?>("abc".defaultOrder() `OrderH:equalsWith<?,IgnoreCase>` "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 }
lib/util/input.0rt view
@@ -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()),"")+}
+ lib/util/parse.0rp view
@@ -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<Char>: Decimal-format floating-point.+ //+ // Returns:+ // - ErrorOr<Float>: 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<Float> value <- ParseChars.float("123.456E5")+ // if (value.isError()) {+ // fail(value.getError())+ // }+ @type float (DefaultOrder<Char>) -> (ErrorOr<Float>)++ // Parses an Int.+ //+ // Args:+ // - DefaultOrder<Char>: Decimal-format integer.+ //+ // Returns:+ // - ErrorOr<Int>: 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<Int> value <- ParseChars.int("123")+ // if (value.isError()) {+ // fail(value.getError())+ // }+ @type int (DefaultOrder<Char>) -> (ErrorOr<Int>)++ // Parses a hex-formatted Int.+ //+ // Args:+ // - DefaultOrder<Char>: Hex-format integer.+ //+ // Returns:+ // - ErrorOr<Int>: 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<Int> value <- ParseChars.hexInt("123ABC")+ // if (value.isError()) {+ // fail(value.getError())+ // }+ @type hexInt (DefaultOrder<Char>) -> (ErrorOr<Int>)++ // Parses a octal-formatted Int.+ //+ // Args:+ // - DefaultOrder<Char>: Octal-format integer.+ //+ // Returns:+ // - ErrorOr<Int>: 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<Int> value <- ParseChars.octInt("755")+ // if (value.isError()) {+ // fail(value.getError())+ // }+ @type octInt (DefaultOrder<Char>) -> (ErrorOr<Int>)++ // Parses a binary-formatted Int.+ //+ // Args:+ // - DefaultOrder<Char>: Binary-format integer.+ //+ // Returns:+ // - ErrorOr<Int>: 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<Int> value <- ParseChars.binInt("10010")+ // if (value.isError()) {+ // fail(value.getError())+ // }+ @type binInt (DefaultOrder<Char>) -> (ErrorOr<Int>)+}
+ lib/util/parse.0rt view
@@ -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"))+}
+ lib/util/parse.0rx view
@@ -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<Char> 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<Float>(c)+ } else {+ needExpDigits <- true+ break+ }+ }+ return autoFail<Float>(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<Float>(c)+ } else {+ needExpDigits <- true+ break+ }+ }+ return autoFail<Float>(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<Float>(c)+ }++ }++ if (present(curr)) {+ return autoFail<Float>(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<Int>(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<Int>(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<Int>(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<Int>(c)+ }++ if (!hasDigit) {+ return ErrorOr:error("missing digits in Int value")+ }++ return ErrorOr:value<?>(sign*total)+ }++ @type autoFail<#x> (Char) -> (ErrorOr<all>)+ autoFail (c) {+ return ErrorOr:error(String.builder()+ .append("failed to parse ")+ .append(typename<#x>().formatted())+ .append(" at '")+ .append(c.formatted())+ .append("'")+ .build())+ }+}
lib/util/src/Extension_Argv.cpp view
@@ -22,10 +22,10 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_Argv(S<Type_Argv> parent, int st, int sz);+BoxedValue CreateValue_Argv(S<Type_Argv> parent, int st, int sz); namespace {-extern const S<TypeValue>& Var_global;+extern const BoxedValue& Var_global; } // namespace struct ExtCategory_Argv : public Category_Argv {@@ -44,28 +44,28 @@ inline ExtValue_Argv(S<Type_Argv> p, int st, int sz) : Value_Argv(p), start(st), size(sz) {} - ReturnTuple Call_readAt(const S<TypeValue>& 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<TypeValue>& 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<TypeValue>& 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<TypeValue>(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<TypeValue>& Var_global = *new S<TypeValue>(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<TypeValue> CreateValue_Argv(S<Type_Argv> parent, int st, int sz) {- return S_get(new ExtValue_Argv(parent, st, sz));+BoxedValue CreateValue_Argv(S<Type_Argv> parent, int st, int sz) {+ return BoxedValue(new ExtValue_Argv(parent, st, sz)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/util/src/Extension_MutexLock.cpp view
@@ -28,7 +28,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_MutexLock(S<Type_MutexLock> parent, const ValueTuple& args);+BoxedValue CreateValue_MutexLock(S<Type_MutexLock> parent, const ValueTuple& args); struct ExtCategory_MutexLock : public Category_MutexLock { };@@ -45,31 +45,32 @@ struct ExtValue_MutexLock : public Value_MutexLock { inline ExtValue_MutexLock(S<Type_MutexLock> 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<TypeValue>& 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<TypeValue> 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<TypeValue> CreateValue_MutexLock(S<Type_MutexLock> parent, const ValueTuple& args) {- return S_get(new ExtValue_MutexLock(parent, args));+BoxedValue CreateValue_MutexLock(S<Type_MutexLock> parent, const ValueTuple& args) {+ return BoxedValue(new ExtValue_MutexLock(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/util/src/Extension_SimpleInput.cpp view
@@ -26,7 +26,7 @@ #endif // ZEOLITE_PUBLIC_NAMESPACE namespace {-extern const S<TypeValue>& 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<Type_SimpleInput> p, const ValueTuple& args) : Value_SimpleInput(p) {} - ReturnTuple Call_pastEnd(const S<TypeValue>& 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<std::mutex> lock(mutex); return ReturnTuple(Box_Bool(zero_read)); } - ReturnTuple Call_readBlock(const S<TypeValue>& 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<std::mutex> 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<TypeValue>& Var_stdin = *new S<TypeValue>(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() {
lib/util/src/Extension_SimpleMutex.cpp view
@@ -27,7 +27,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_SimpleMutex(S<Type_SimpleMutex> parent);+BoxedValue CreateValue_SimpleMutex(S<Type_SimpleMutex> parent); struct ExtCategory_SimpleMutex : public Category_SimpleMutex { };@@ -44,13 +44,13 @@ struct ExtValue_SimpleMutex : public Value_SimpleMutex { inline ExtValue_SimpleMutex(S<Type_SimpleMutex> p) : Value_SimpleMutex(p) {} - ReturnTuple Call_lock(const S<TypeValue>& 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<TypeValue>& 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<TypeValue> CreateValue_SimpleMutex(S<Type_SimpleMutex> parent) {- return S_get(new ExtValue_SimpleMutex(parent));+BoxedValue CreateValue_SimpleMutex(S<Type_SimpleMutex> parent) {+ return BoxedValue(new ExtValue_SimpleMutex(parent)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
lib/util/src/Extension_SimpleOutput.cpp view
@@ -27,9 +27,9 @@ #endif // ZEOLITE_PUBLIC_NAMESPACE namespace {-extern const S<TypeValue>& Var_stdout;-extern const S<TypeValue>& Var_stderr;-extern const S<TypeValue>& 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<Type_SimpleOutput> p, S<Writer> w) : Value_SimpleOutput(p), writer(w) {} - ReturnTuple Call_flush(const S<TypeValue>& 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<std::mutex> lock(mutex); writer->Flush(); return ReturnTuple(); } - ReturnTuple Call_write(const S<TypeValue>& 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<TypeValue>& Var_arg1 = (args.At(0));+ const BoxedValue& Var_arg1 = (args.At(0)); std::lock_guard<std::mutex> 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<TypeValue>& Var_stdout = *new S<TypeValue>(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), S_get(new StreamWriter(std::cout))));-const S<TypeValue>& Var_stderr = *new S<TypeValue>(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), S_get(new StreamWriter(std::cerr))));-const S<TypeValue>& Var_error = *new S<TypeValue>(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
+ lib/util/testing.0rp view
@@ -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<Formatted>: Actual value.+ @type checkError (ErrorOr<Formatted>) -> ()++ // 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) -> ()+}
+ lib/util/testing.0rt view
@@ -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)+}
+ lib/util/testing.0rx view
@@ -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)+ }+ }+}
src/Base/CompilerError.hs view
@@ -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 (<??) :: ErrorContextM m => m a -> String -> m a (<??) = withContextM
src/Base/TrackedErrors.hs view
@@ -23,6 +23,7 @@ module Base.TrackedErrors ( TrackedErrors, TrackedErrorsIO,+ TrackedErrorsT, asCompilerError, asCompilerWarnings, fromTrackedErrors,@@ -68,7 +69,7 @@ data TrackedErrorsT m a = TrackedErrorsT {- citState :: m (TrackedErrorsState a)+ tetState :: m (TrackedErrorsState a) } getCompilerError :: TrackedErrors 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
src/Cli/CompileOptions.hs view
@@ -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 _ = []
src/Cli/Compiler.hs view
@@ -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."
src/Cli/ParseCompileOptions.hs view
@@ -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."
src/Cli/Programs.hs view
@@ -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)
src/Cli/RunCompiler.hs view
@@ -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 <?? "In compilation of \"" ++ f2' ++ "\"" errorFromIO $ removeDirectoryRecursive dir -runCompiler resolver backend (CompileOptions h _ _ ds _ _ p CompileRecompileRecursive f) = do- foldM (recursive resolver) Set.empty (map ((,) p) ds) >> 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 <?? "In compilation of module \"" ++ d ++ "\""+runCompiler resolver backend (CompileOptions _ _ _ ds _ _ p CompileRecompile f) =+ runRecompileCommon resolver backend f False p ds runCompiler resolver backend (CompileOptions _ is is2 ds _ _ p CreateTemplates f) = mapM_ compileSingle ds where compilerHash = getCompilerHash backend@@ -188,7 +144,7 @@ (ModuleConfig _ _ _ is3 is4 _ _ _) <- rm return (nub $ is ++ is3,nub $ is2 ++ is4) -runCompiler resolver backend (CompileOptions h is is2 ds es ep p m f) = mapM_ compileSingle ds where+runCompiler resolver _ (CompileOptions _ is is2 ds es ep p m f) = mapM_ compileSingle ds where compileSingle d = do as <- fmap fixPaths $ mapCompilerM (resolveModule resolver (p </> 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 <?? "In compilation of module \"" ++ d ++ "\""
src/Cli/TestRunner.hs view
@@ -23,7 +23,7 @@ import Control.Arrow (second) import Control.Monad (when) import Control.Monad.IO.Class-import Data.List (isSuffixOf,nub,sort)+import Data.List (intercalate,isSuffixOf,nub,sort) import System.Directory import System.IO import System.Posix.Temp (mkdtemp)@@ -48,9 +48,9 @@ runSingleTest :: CompilerBackend b => 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) <?? scope errorFromIO $ hPutStrLn stderr $ "\n*** Executing testcase " ++ name ++ " ***"- result <- toTrackedErrors $ run (ithResult $ itHeader t) (ithArgs $ itHeader t) (itCategory t) (itDefinition t) (itTests t)+ result <- toTrackedErrors $ run (ithResult $ itHeader t)+ (ithArgs $ itHeader t)+ (ithTimeout $ itHeader t)+ (itCategory t) (itDefinition t) (itTests t) if isCompilerError result then return ((0,1),scope ??> (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 <?? "\nOutput from compiler:"]+ asCompilerError res <?? "\nOutput from compiler:"] _ -> 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
src/CompilerCxx/Code.hs view
@@ -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<TypeValue>"- | otherwise = "S<TypeValue>"+ | 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<TypeValue>&"- | otherwise = "S<TypeValue>&"+ | isWeakValue t = "WeakValue&"+ | otherwise = "BoxedValue&" readStoredVariable :: Bool -> ValueType -> String -> ExpressionValue readStoredVariable True t s = LazySingle $ readStoredVariable False t s
src/CompilerCxx/CxxFiles.hs view
@@ -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<TypeValue>& 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<TypeValue>& 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 <unistd.h>",+ "#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<TypeInstance>&, const ParamTuple&, const ValueTuple&);" | s == ValueScope = " using CallType = ReturnTuple(" ++ valueName n ++- "::*)(const S<TypeValue>&, 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<TypeValue> " ++ 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<TypeValue> " ++ 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));", "}" ]
src/CompilerCxx/Naming.hs view
@@ -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"
src/CompilerCxx/Procedure.hs view
@@ -76,7 +76,7 @@ "(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args)" | sfScope f == ValueScope = "ReturnTuple " ++ name ++- "(const S<TypeValue>& 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<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args)" ++ final ++ " {" | s == ValueScope = returnType ++ " " ++ prefix ++ name ++- "(const S<TypeValue>& 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) <??- "In return at " ++ formatFullContext c- return (map (head . pValues . fst) rs,- "ArgTuple(" ++ intercalate ", " (map (useAsUnwrapped . snd) rs) ++ ")")- checkArity (_,Positional [_]) = return ()- checkArity (i,Positional ts) =- compilerErrorM $ "Initializer position " ++ show i ++ " has " ++ show (length ts) ++ " values but should have 1"+ formatFullContextBrace c compile (InfixExpression c e1 (FunctionOperator _ (FunctionSpec _ (CategoryFunction c2 cn) fn ps)) e2) = compile (Expression c (CategoryCall c2 cn (FunctionCall c fn ps (Positional [e1,e2]))) []) compile (InfixExpression c e1 (FunctionOperator _ (FunctionSpec _ (TypeFunction c2 tn) fn ps)) e2) =@@ -716,7 +650,7 @@ compilerErrorM $ "Cannot " ++ show o ++ " " ++ show t1 ++ " and " ++ show t2 ++ formatFullContextBrace c glueInfix t1 t2 e3 o2 e4 =- UnboxedPrimitive t2 $ useAsUnboxed t1 e3 ++ o2 ++ useAsUnboxed t1 e4+ UnboxedPrimitive t2 $ "(" ++ useAsUnboxed t1 e3 ++ ")" ++ o2 ++ "(" ++ useAsUnboxed t1 e4 ++ ")" transform e (ConvertedCall c t f) = do (Positional ts,e') <- e t' <- requireSingle c ts@@ -813,7 +747,7 @@ when (isWeakValue t0) $ compilerErrorM $ "Weak values not allowed here" ++ formatFullContextBrace c return $ (Positional [boolRequiredValue],- UnboxedPrimitive PrimBool $ valueBase ++ "::Present(" ++ useAsUnwrapped e ++ ")")+ UnboxedPrimitive PrimBool $ "BoxedValue::Present(" ++ useAsUnwrapped e ++ ")") compileExpressionStart (BuiltinCall c (FunctionCall _ BuiltinReduce ps es)) = do when (length (pValues ps) /= 2) $ compilerErrorM $ "Expected 2 type parameters" ++ formatFullContextBrace c@@ -851,7 +785,7 @@ when (isWeakValue t0) $ compilerErrorM $ "Weak values not allowed here" ++ formatFullContextBrace c return $ (Positional [ValueType RequiredValue (vtType t0)],- UnwrappedSingle $ valueBase ++ "::Require(" ++ useAsUnwrapped e ++ ")")+ UnwrappedSingle $ "BoxedValue::Require(" ++ useAsUnwrapped e ++ ")") compileExpressionStart (BuiltinCall c (FunctionCall _ BuiltinStrong ps es)) = do when (length (pValues ps) /= 0) $ compilerErrorM $ "Expected 0 type parameters" ++ formatFullContextBrace c@@ -864,7 +798,7 @@ let t1 = Positional [ValueType OptionalValue (vtType t0)] if isWeakValue t0 -- Weak values are already unboxed.- then return (t1,UnwrappedSingle $ valueBase ++ "::Strong(" ++ useAsUnwrapped e ++ ")")+ then return (t1,UnwrappedSingle $ "BoxedValue::Strong(" ++ useAsUnwrapped e ++ ")") else return (t1,e) compileExpressionStart (BuiltinCall c (FunctionCall _ BuiltinTypename ps es)) = do when (length (pValues ps) /= 1) $@@ -895,7 +829,81 @@ let lazy = s == CategoryScope return (Positional [t0],readStoredVariable lazy t0 $ "(" ++ scoped ++ variableName n ++ " = " ++ writeStoredVariable t0 e' ++ ")")+compileExpressionStart (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) <??+ "In return at " ++ formatFullContext c+ return (map (head . pValues . fst) rs,+ "ArgTuple(" ++ intercalate ", " (map (useAsUnwrapped . snd) rs) ++ ")")+ checkArity (_,Positional [_]) = return ()+ checkArity (i,Positional ts) =+ compilerErrorM $ "Initializer position " ++ show i ++ " has " ++ show (length ts) ++ " values but should have 1"+compileExpressionStart (UnambiguousLiteral l) = compileValueLiteral l +compileValueLiteral :: (Ord c, Show c, CollectErrorsM m,+ CompilerContext c m [String] a) =>+ 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
src/Config/LocalConfig.hs view
@@ -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]) <?? "In compilation of " ++ s- if e- then do- -- Extra files are put into .a since they will be unconditionally- -- included. This prevents unwanted symbol dependencies.- arName <- errorFromIO $ canonicalizePath $ p </> (takeFileName $ dropExtension s ++ ".a")- executeProcess ab ["-q",arName,objName] <?? "In packaging of " ++ objName- return arName- else return objName where- otherOptions = map (("-I" ++) . normalise) ps ++ map macro ms- macro (n,Just v) = "-D" ++ n ++ "=" ++ v- macro (n,Nothing) = "-D" ++ n- runCxxCommand (UnixBackend cb co _) (CompileToBinary m ss o ps lf) = do- let arFiles = filter (isSuffixOf ".a") ss- let otherFiles = filter (not . isSuffixOf ".a") ss- let otherOptions = map ("-I" ++) (map normalise ps)- let flags = nub lf- let args = co ++ otherOptions ++ m:otherFiles ++ arFiles ++ ["-o", o] ++ flags- executeProcess cb args <?? "In linking of " ++ o- return o+ runCxxCommand = run where+ run (UnixBackend cb ff _ _ ab) (CompileToObject s p ms ps e) = do+ objName <- errorFromIO $ canonicalizePath $ p </> (takeFileName $ dropExtension s ++ ".o")+ let otherOptions = map (("-I" ++) . normalise) ps ++ map macro ms+ executeProcess cb (ff ++ otherOptions ++ ["-c", s, "-o", objName]) <?? "In compilation of " ++ s+ if e+ then do+ -- Extra files are put into .a since they will be unconditionally+ -- included. This prevents unwanted symbol dependencies.+ arName <- errorFromIO $ canonicalizePath $ p </> (takeFileName $ dropExtension s ++ ".a")+ executeProcess ab ["-q",arName,objName] <?? "In packaging of " ++ objName+ return arName+ else return objName+ run (UnixBackend cb _ ff _ _) (CompileToShared ss o lf) = do+ let arFiles = filter (isSuffixOf ".a") ss+ let otherFiles = filter (not . isSuffixOf ".a") ss+ let flags = nub lf+ let args = ff ++ otherFiles ++ arFiles ++ ["-o", o] ++ flags+ executeProcess cb args <?? "In linking of " ++ o+ return o+ run (UnixBackend cb _ _ ff _) (CompileToBinary m ss ms o ps lf) = do+ let arFiles = filter (isSuffixOf ".a") ss+ let otherFiles = filter (not . isSuffixOf ".a") ss+ let otherOptions = map (("-I" ++) . normalise) ps ++ map macro ms+ let flags = nub lf+ let args = ff ++ otherOptions ++ m:otherFiles ++ arFiles ++ ["-o", o] ++ flags+ executeProcess cb args <?? "In linking of " ++ o+ return o+ macro (n,Just v) = "-D" ++ n ++ "=" ++ v+ macro (n,Nothing) = "-D" ++ n runTestCommand _ (TestCommand b p as) = errorFromIO $ do (outF,outH) <- mkstemps "/tmp/ztest_" ".txt" (errF,errH) <- mkstemps "/tmp/ztest_" ".txt"
src/Module/CompileMetadata.hs view
@@ -22,6 +22,7 @@ ModuleConfig(..), ObjectFile(..), isCategoryObjectFile,+ getObjectFiles, mergeObjectFiles, ) where @@ -53,6 +54,7 @@ cmHxxFiles :: [FilePath], cmCxxFiles :: [FilePath], cmBinaries :: [FilePath],+ cmLibraries :: [FilePath], cmLinkFlags :: [FilePath], cmObjectFiles :: [ObjectFile] }@@ -92,6 +94,10 @@ isCategoryObjectFile :: ObjectFile -> Bool isCategoryObjectFile (CategoryObjectFile _ _ _) = True isCategoryObjectFile (OtherObjectFile _) = False++getObjectFiles :: ObjectFile -> [FilePath]+getObjectFiles (CategoryObjectFile _ _ os) = os+getObjectFiles (OtherObjectFile o) = [o] data ModuleConfig = ModuleConfig {
src/Module/ParseMetadata.hs view
@@ -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
src/Module/ProcessMetadata.hs view
@@ -25,11 +25,13 @@ getCacheRelativePath, getExprMap, getIncludePathsForDeps,+ getLibrariesForDeps, getLinkFlagsForDeps, getNamespacesForDeps, getObjectFilesForDeps, getObjectFileResolver, getRealPathsForDeps,+ getRecompilePath, getSourceFilesForDeps, isPathConfigured, isPathUpToDate,@@ -135,6 +137,11 @@ m' <- autoWriteConfig m <?? "In data for " ++ p errorFromIO $ writeFile f m' +getRecompilePath :: FilePath -> 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
src/Parser/Common.hs view
@@ -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
src/Parser/IntegrationTest.hs view
@@ -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"
src/Parser/Procedure.hs view
@@ -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
src/Test/IntegrationTest.hs view
@@ -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"
src/Test/ParseMetadata.hs view
@@ -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),
src/Test/Procedure.hs view
@@ -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
src/Test/TrackedErrors.hs view
@@ -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
src/Test/TypeCategory.hs view
@@ -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 <!! context where@@ -1208,7 +1208,7 @@ ia2 <- fmap Map.fromList $ mapCompilerM readInferred is ts2 <- mapCompilerM (parsePair ia2 Covariant) ts let ka = Map.keysSet ia2- gs' <- mapCompilerM parseGuess gs+ gs' <- fmap Map.fromList $ mapCompilerM parseGuess gs let f = Map.filterWithKey (\k _ -> not $ k `Set.member` ka) pa2 let ff = Map.filterWithKey (\k _ -> k `Set.member` ka) pa2 gs2 <- inferParamTypes r f ia2 ts2@@ -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)
src/Test/testfiles/basic_crash_test.0rt view
@@ -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 {
src/Test/testfiles/basic_success_test.0rt view
@@ -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 {
+ src/Test/testfiles/function_filter_type_param.0rx view
@@ -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)+}
src/Test/testfiles/module-cache.txt view
@@ -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"
src/Types/Builtin.hs view
@@ -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
src/Types/IntegrationTest.hs view
@@ -42,6 +42,7 @@ ithContext :: [c], ithTestName :: String, ithArgs :: [String],+ ithTimeout :: Maybe Integer, ithResult :: ExpectedResult c }
src/Types/Procedure.hs view
@@ -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 =
src/Types/TypeCategory.hs view
@@ -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) <!! "Type for param " ++ show i ++ " is ambiguous"- return lo- takeBest i gs = mapErrorsM (map show gs) <!! "Type for param " ++ show i ++ " is ambiguous"- filterGuesses i (GuessUnion gs) = do- let ga = map (filterGuess i) gs- collectFirstM_ ga <!! "No valid guesses for param " ++ show i- gs' <- collectAnyM ga- fmap GuessUnion (simplifyUnion gs')- filterGuess i g@(GuessRange (Just lo) Nothing) = checkSubFilters i lo >> 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 <!! "No feasible param guesses found"+ collectAnyM gs2+ filterGuess gs = checkSubFilters gs >> return gs+ extractGuesses (i,is) = do+ let is2 = map (extractSingle i) is+ collectFirstM_ is2 <!! "No feasible guesses for param " ++ show i+ fmap nub $ collectAnyM is2+ extractSingle i (GuessRange (Just lo) Nothing) = return (i,lo)+ extractSingle i (GuessRange Nothing (Just hi)) = return (i,hi)+ extractSingle i g@(GuessRange (Just lo) (Just hi)) = do+ p <- (Just hi) `convertsTo` (Just lo)+ if p+ then return (i,lo)+ else compilerErrorM $ "Ambiguous guess for param " ++ show i ++ ": " ++ show g+ extractSingle i g@(GuessRange Nothing Nothing) =+ compilerErrorM $ "Ambiguous guess for param " ++ show i ++ ": " ++ show g+ checkSubFilters gs = "In validation of inference guess: " ++ describeGuess gs ??> 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)
tests/builtin-types.0rt view
@@ -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) }
tests/cli-tests.sh view
@@ -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" <<END-// $file--concrete $category {- @type run () -> ()-}--define $category {- run () {- \ LazyStream<Formatted>.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
+ tests/fast-static/README.md view
@@ -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!+```
+ tests/fast-static/program.0rx view
@@ -0,0 +1,12 @@+concrete Program {+ @type run () -> ()+}++define Program {+ run () {+ \ LazyStream<Formatted>.new()+ .append($ExprLookup[MODULE_PATH]$ + "\n")+ .append("Static linking works!\n")+ .writeTo(SimpleOutput.stdout())+ }+}
tests/inference.0rt view
@@ -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<String> x <- Type<String>.create()- Type<Int> y <- Type<Int>.create()- \ Test.get<?,?>(x,y)+ Type<String> x <- Type<String>.create()+ Type<String> y <- Type<String>.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<Int,String>+ @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 (_,_,_) {} }
+ tests/leak-check/.zeolite-module view
@@ -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+}
+ tests/leak-check/README.md view
@@ -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.
+ tests/leak-check/leak-check.0rx view
@@ -0,0 +1,126 @@+concrete LeakTest {+ @type run () -> ()+}++define LeakTest {+ @value Vector<Int> memory++ run () {+ if (Argv.global().size() != 2) {+ \ message()+ } elif (Argv.global().readAt(1) == "race") {+ \ runWith(1000,0)+ \ LazyStream<Formatted>.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<BarrierWait> barriers <- EnumeratedBarrier.new(threads+1)+ traverse (Counter.zeroIndexed(iterations) -> Int i) {+ \ doIteration<LastReference>(i,size,barriers)+ \ doIteration<Chaos>(i,size,barriers)+ }+ }++ @type doIteration<#f>+ #f defines ThreadFactory+ (Int,Int,ReadAt<BarrierWait>) -> ()+ doIteration (i,size,barriers) {+ \ LazyStream<Formatted>.new()+ .append(typename<#f>())+ .append(": iteration ")+ .append(i)+ .append("\n")+ .writeTo(SimpleOutput.stderr())++ optional LeakTest original <- LeakTest{ Vector:createSize<Int>(size) }++ Vector<Thread> threads <- Vector:create<Thread>()++ 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+ }+}
tests/module-only4/common-source.cpp view
@@ -29,7 +29,7 @@ namespace ZEOLITE_PRIVATE_NAMESPACE { #endif // ZEOLITE_PRIVATE_NAMESPACE -S<TypeValue> CreateValue_Type1(S<Type_Type1> parent, const ValueTuple& args);+BoxedValue CreateValue_Type1(S<Type_Type1> parent, const ValueTuple& args); struct ExtCategory_Type1 : public Category_Type1 { };@@ -48,12 +48,12 @@ inline ExtValue_Type1(S<Type_Type1> p, const ValueTuple& args) : Value_Type1(p), value(args.At(0)) {} - ReturnTuple Call_get(const S<TypeValue>& 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<TypeValue> 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<TypeValue> CreateValue_Type1(S<Type_Type1> parent, const ValueTuple& args) {- return S_get(new ExtValue_Type1(parent, args));+BoxedValue CreateValue_Type1(S<Type_Type1> 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<TypeValue> CreateValue_Type3(S<Type_Type3> parent, const ValueTuple& args);+BoxedValue CreateValue_Type3(S<Type_Type3> parent, const ValueTuple& args); struct ExtCategory_Type3 : public Category_Type3 { };@@ -97,12 +97,12 @@ inline ExtValue_Type3(S<Type_Type3> p, const ValueTuple& args) : Value_Type3(p), value(args.At(0)) {} - ReturnTuple Call_get(const S<TypeValue>& 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<TypeValue> 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<TypeValue> CreateValue_Type3(S<Type_Type3> parent, const ValueTuple& args) {- return S_get(new ExtValue_Type3(parent, args));+BoxedValue CreateValue_Type3(S<Type_Type3> parent, const ValueTuple& args) {+ return BoxedValue(new ExtValue_Type3(parent, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
tests/simple.0rt view
@@ -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) {}+}
tests/tracing.0rt view
@@ -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 {
zeolite-lang.cabal view
@@ -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