packages feed

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 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