zeolite-lang 0.15.0.0 → 0.16.0.0

raw patch · 145 files changed

+4458/−2129 lines, 145 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +137/−0
• base/Category_Bool.cpp +50/−50
• base/Category_Char.cpp +56/−66
• base/Category_Float.cpp +51/−56
• base/Category_Int.cpp +56/−66
• base/Category_String.cpp +95/−70
• base/builtin.0rp +31/−0
• base/category-header.hpp +1/−5
• base/category-source.cpp +21/−0
• base/category-source.hpp +73/−0
• base/logging.cpp +54/−0
• base/logging.hpp +50/−12
• example/parser/parse-text.0rx +24/−23
• example/parser/test-data.0rx +19/−0
• example/primes/.zeolite-module +11/−0
• example/primes/README.md +57/−0
• example/primes/flag.0rp +32/−0
• example/primes/flag.0rx +64/−0
• example/primes/prime-thread.0rp +8/−0
• example/primes/prime-thread.0rx +14/−0
• example/primes/prime-tracker.0rp +9/−0
• example/primes/prime-tracker.0rx +46/−0
• example/primes/primes-demo.0rx +62/−0
• lib/container/interfaces.0rp +13/−0
• lib/container/search-tree.0rp +19/−1
• lib/container/search-tree.0rt +46/−2
• lib/container/search-tree.0rx +130/−17
• lib/container/src/Extension_Vector.cpp +41/−8
• lib/container/vector.0rp +3/−2
• lib/container/vector.0rt +19/−0
• lib/file/src/Extension_RawFileReader.cpp +7/−7
• lib/file/src/Extension_RawFileWriter.cpp +7/−7
• lib/math/src/Extension_Math.cpp +0/−4
• lib/testing/helpers.0rp +1/−1
• lib/thread/.zeolite-module +14/−0
• lib/thread/README.md +3/−5
• lib/thread/barrier-ext.0rp +23/−0
• lib/thread/barrier.0rp +46/−0
• lib/thread/barrier.0rt +178/−0
• lib/thread/condition.0rp +106/−0
• lib/thread/condition.0rt +179/−0
• lib/thread/mutex.0rt +0/−35
• lib/thread/src/Extension_Enumerated.cpp +194/−0
• lib/thread/src/Extension_MutexLock.cpp +8/−8
• lib/thread/src/Extension_ProcessThread.cpp +13/−13
• lib/thread/src/Extension_Realtime.cpp +69/−0
• lib/thread/src/Extension_SimpleMutex.cpp +4/−4
• lib/thread/src/Extension_ThreadCondition.cpp +164/−0
• lib/thread/testing.0rp +16/−0
• lib/thread/testing.0rx +35/−0
• lib/thread/thread.0rt +52/−8
• lib/thread/time.0rp +23/−0
• lib/thread/time.0rt +35/−0
• lib/util/counters.0rp +33/−0
• lib/util/counters.0rt +69/−0
• lib/util/counters.0rx +86/−0
• lib/util/extra.0rp +0/−1
• lib/util/src/Extension_Argv.cpp +7/−7
• lib/util/src/Extension_SimpleInput.cpp +2/−2
• lib/util/src/Extension_SimpleOutput.cpp +5/−5
• src/Cli/CompileOptions.hs +10/−4
• src/Cli/Compiler.hs +6/−6
• src/Cli/ParseCompileOptions.hs +21/−10
• src/Cli/RunCompiler.hs +11/−3
• src/Cli/TestRunner.hs +6/−6
• src/Compilation/CompilerState.hs +3/−7
• src/Compilation/ProcedureContext.hs +16/−29
• src/Compilation/ScopeContext.hs +24/−35
• src/CompilerCxx/CategoryContext.hs +10/−18
• src/CompilerCxx/Code.hs +35/−63
• src/CompilerCxx/CxxFiles.hs +96/−84
• src/CompilerCxx/LanguageModule.hs +13/−14
• src/CompilerCxx/Naming.hs +9/−5
• src/CompilerCxx/Procedure.hs +70/−22
• src/Module/CompileMetadata.hs +4/−0
• src/Module/ParseMetadata.hs +0/−1
• src/Parser/Common.hs +6/−1
• src/Parser/DefinedCategory.hs +14/−21
• src/Parser/Procedure.hs +25/−23
• src/Parser/TypeCategory.hs +4/−10
• src/Test/Common.hs +22/−13
• src/Test/DefinedCategory.hs +3/−5
• src/Test/ParseMetadata.hs +1/−1
• src/Test/TypeCategory.hs +59/−166
• src/Test/TypeInstance.hs +33/−64
• src/Test/testfiles/allows_variance_left.0rx +5/−0
• src/Test/testfiles/allows_variance_right.0rx +5/−0
• src/Test/testfiles/bad_allows_variance_left.0rx +0/−5
• src/Test/testfiles/bad_allows_variance_right.0rx +0/−5
• src/Test/testfiles/bad_defines_variance_left.0rx +0/−5
• src/Test/testfiles/bad_defines_variance_right.0rx +0/−5
• src/Test/testfiles/bad_requires_variance_left.0rx +0/−5
• src/Test/testfiles/bad_requires_variance_right.0rx +0/−5
• src/Test/testfiles/concrete_instances.0rx +0/−33
• src/Test/testfiles/concrete_missing_define.0rx +0/−22
• src/Test/testfiles/concrete_missing_refine.0rx +0/−23
• src/Test/testfiles/defines_variance_left.0rx +5/−0
• src/Test/testfiles/defines_variance_right.0rx +5/−0
• src/Test/testfiles/filtered_self.0rx +0/−14
• src/Test/testfiles/function_bad_allows_type.0rx +0/−9
• src/Test/testfiles/function_bad_arg.0rx +0/−9
• src/Test/testfiles/function_bad_defines_type.0rx +0/−9
• src/Test/testfiles/function_bad_requires_type.0rx +0/−9
• src/Test/testfiles/function_bad_return.0rx +0/−9
• src/Test/testfiles/function_defines_missed.0rx +0/−2
• src/Test/testfiles/internal_filters.0rx +0/−7
• src/Test/testfiles/internal_params.0rx +0/−3
• src/Test/testfiles/requires_variance_left.0rx +5/−0
• src/Test/testfiles/requires_variance_right.0rx +5/−0
• src/Test/testfiles/type_instances.0rx +0/−33
• src/Test/testfiles/type_interface.0rx +0/−4
• src/Test/testfiles/type_missing_define.0rx +0/−22
• src/Test/testfiles/type_missing_refine.0rx +0/−23
• src/Test/testfiles/value_instances.0rx +0/−33
• src/Test/testfiles/value_interface.0rx +0/−3
• src/Test/testfiles/value_missing_define.0rx +0/−22
• src/Test/testfiles/value_missing_refine.0rx +0/−23
• src/Types/Builtin.hs +44/−4
• src/Types/DefinedCategory.hs +32/−5
• src/Types/Function.hs +10/−10
• src/Types/Procedure.hs +13/−6
• src/Types/TypeCategory.hs +84/−116
• src/Types/TypeInstance.hs +49/−30
• tests/builtin-types.0rt +26/−2
• tests/cli-tests.sh +32/−4
• tests/filters.0rt +253/−5
• tests/function-calls.0rt +4/−2
• tests/inference.0rt +32/−1
• tests/internal-params.0rt +0/−368
• tests/local-rules.0rt +170/−0
• tests/member-init.0rt +50/−1
• tests/module-only4/common-source.cpp +12/−12
• tests/reduce.0rt +0/−24
• tests/regressions.0rt +1/−1
• tests/self-type.0rt +47/−40
• tests/templates/.zeolite-module +4/−0
• tests/templates/README.md +4/−4
• tests/templates/private.0rp +23/−0
• tests/templates/public.0rp +26/−0
• tests/templates/templates.0rp +0/−26
• tests/templates/tests.0rt +8/−8
• tests/tracing.0rt +27/−1
• tests/traverse.0rt +300/−0
• tests/typename.0rt +0/−20
• zeolite-lang.cabal +5/−1

@@ -1,5 +1,142 @@ # Revision history for zeolite-lang +## 0.16.0.0  -- 2021-04-01++### Language++* **[breaking]** Disallows param filters in `@value interface` and+  `@type interface`. Param filters are only used to allow procedures to call+  `@type` and `@value` functions. Previously, they were enforced in all+  situations where param substitution occurred, but this is no longer the case.+  (See further down in this list.)++* **[breaking]** Removes support for internal type params for values. This was+  an obscure feature that was never documented and was only used in some+  integration tests that had not been touched in over 2 years. This breaks most+  hand-written C++ extensions, but they can be fixed by removing the+  `ParamTuple` argument passed to the base-class constructor in `ExtValue_Foo`+  for C++ extension `Foo`.++* **[breaking]** Adds the `traverse` built-in syntax, which automatically+  iterates over a container that exposes the (new) `Order<|#x>`+  `@value interface`. (This is breaking because `traverse`, `Order`, and+  `DefaultOrder` are now reserved.)++  ```text+  traverse (container.defaultOrder() -> Foo value) {+    // executed once per Foo in the container+  }+  ```++* **[breaking]** Marks `@category` member variables as read-only when+  initializing other member variables. Essentially, this just means that you can+  no longer do something like this:++  ```text+  @category Int foo <- 1+  @category Int bar <- (foo <- 2)+  ```++* **[new]** Removes the requirement that type instances (e.g., `Type<Int>`)+  satisfy the requirements of the type's parameter filters when not being used+  in a function call.++  ```text+  concrete Type<|#x> {+    #x requires Foo+  }+  ```++  In the example above, `Type<Bar>` was universally disallowed if `Bar` could+  not be converted to `Foo`. The new behavior is to enforce that restriction+  only when calling `@type` functions, initializing values (e.g.,+  `Type<#x>{ }`), and using the type as a param in a function call.++  Since `#x` is covariant in this example, you could convert a `Type<Bar>` to a+  `Type<any>`, even though `any` is not a child of `Foo`.++* **[new]** Removes variance checks for category-level param filters. Variance+  was originally *not* checked, but then the checks were added prior to version+  `0.1.0.0` for obscure mathematical reasons that no longer make sense.++  In particular, filters such as `#x defines Equals<#x>` *were not* previously+  allowed except when `#x` was invariant, but now it is allowed for all+  variances.++  The revised perspective is that param filters form a meta-type for param+  substitutions as inputs, with the constructed type as the output. Once the+  output is received, the input constraints are no longer recoverable.++  Note that category-level param variance is still checked when params are used+  on the right side of filters for function params. This is because not doing so+  could result in bad argument and return types when inheriting functions.++  Params also still cannot have *both* upper and lower bounds at the same time.++* **[new]** When inferring type parameters for function calls (e.g.,+  `call<?>(foo)`), allows `all` to be a valid lower bound and `any` to be a+  valid upper bound. Previously, an inferred type of `all` in covariant+   positions and `any` in contravariant positions would cause inference to fail.++* **[new]** Allows `$ReadOnly[...]$` and `$Hidden[...]$` for member variables in+  definitions of `concrete` categories.++* **[new]** Makes `Argv` available to all threads. Previously, it was only+  available to the main thread. (Even though `Argv` is exposed via `lib/util`,+  this change also affects C++ extensions that use `Argv` from `logging.hpp`.)++* **[fix]** Fixes regression with function names used in stack traces.+  Previously, if a function was inherited and the types were not overridden,+  the category name in the trace would be that of the parent, rather than that+  of the one defining the procedure.++### Compiler CLI++* **[breaking]** Removes the default compiler mode when calling `zeolite`. The+  previous default was `-c`, which creates a new `.zeolite-module` for+  incremental library compilation. The default was removed because accidentally+  typing `zeolite -f foo` instead of `zeolite -t foo` would overwrite the+  `.zeolite-module` for `foo` rather than running its tests.++* **[breaking]** Updates how `$TraceCreation$` is implemented in C++. This only+  breaks hand-written C++ extensions that use the `CAPTURE_CREATION` macro,+  which now must pass a string-literal category name as a macro argument,+  e.g., `CAPTURE_CREATION("Foo")`.++* **[new]** Adds the `--log-traces` option for testing mode (`zeolite -t`) to+  capture a record of every line of Zeolite code executed when running tests.++* **[fix]** Fixes dependency resolution for C++ extensions that define+  `$ModuleOnly$` categories.++* **[behavior]** Improves the efficiency of call dispatching and `reduce` calls+  for categories that inherit a lot of `interface`s. This is unlikely to affect+  performance when a category has less than 10 direct or indirect parent+  `interface`s.++### Libraries++* **[new]** Adds `ThreadCondition` to `lib/thread`, which allows threads to wait+  for an arbitrary condition signaled by another thread. (Similar to+  `pthread_cond_t` in POSIX.)++* **[new]** Adds `EnumeratedBarrier` to `lib/thread`, which can be use to+  synchronize a fixed number of threads. (Similar to `pthread_barrier_t` in+  POSIX, but with strict validation to help prevent deadlocks.)++* **[new]** Adds `Realtime` to `lib/thread`, to allow threads to sleep based on+  wall time.++* **[new]** Adds `Counter` and `Repeat` to `lib/util`, to help create sequences+  for use with the new `traverse` built-in syntax.++* **[new]** Implements forward and reverse iteration to `SearchTree` in+  `lib/container`.++### Examples++* Adds `example/primes`, as a demonstration of multithreading.+ ## 0.15.0.0  -- 2021-03-24  ### Language

@@ -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.@@ -41,7 +41,6 @@ class Category_Bool; class Type_Bool; class Value_Bool;-S<TypeValue> CreateValue(Type_Bool& parent, const ParamTuple& params, const ValueTuple& args); struct Category_Bool : public TypeCategory {   std::string CategoryName() const final { return "Bool"; }   Category_Bool() {@@ -72,25 +71,34 @@     }     return true;   }+  void Params_Bool(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsBool(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsInt(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsFloat(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_Formatted(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }   bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {-    if (&category == &GetCategory_Bool()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsBool()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsInt()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsFloat()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_Formatted()) {-      args = std::vector<S<const TypeInstance>>{};+    using CallType = void(Type_Bool::*)(std::vector<S<const TypeInstance>>&)const;+    static DispatchSingle<CallType> all_calls[] = {+      DispatchSingle<CallType>(&GetCategory_AsBool(),    &Type_Bool::Params_AsBool),+      DispatchSingle<CallType>(&GetCategory_AsFloat(),   &Type_Bool::Params_AsFloat),+      DispatchSingle<CallType>(&GetCategory_AsInt(),     &Type_Bool::Params_AsInt),+      DispatchSingle<CallType>(&GetCategory_Bool(),      &Type_Bool::Params_Bool),+      DispatchSingle<CallType>(&GetCategory_Formatted(), &Type_Bool::Params_Formatted),+      DispatchSingle<CallType>(),+    };+    const DispatchSingle<CallType>* const call = DispatchSelect(&category, all_calls);+    if (call) {+      (this->*call->value)(args);       return true;     }     return false;@@ -109,18 +117,19 @@     static const CallType Table_Equals[] = {       &Type_Bool::Call_equals,     };-    if (label.collection == Functions_Default) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_Default, Table_Default),+      DispatchTable<CallType>(Functions_Equals,  Table_Equals),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(params, args);       }-      return (this->*Table_Default[label.function_num])(params, args);     }-    if (label.collection == Functions_Equals) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_Equals[label.function_num])(params, args);-    }     return TypeInstance::Dispatch(self, label, params, args);   }   ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args);@@ -146,29 +155,20 @@     static const CallType Table_Formatted[] = {       &Value_Bool::Call_formatted,     };-    if (label.collection == Functions_AsBool) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsBool[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsFloat) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsFloat[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsInt) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsInt[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_Formatted) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_AsBool,    Table_AsBool),+      DispatchTable<CallType>(Functions_AsFloat,   Table_AsFloat),+      DispatchTable<CallType>(Functions_AsInt,     Table_AsInt),+      DispatchTable<CallType>(Functions_Formatted, Table_Formatted),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(self, params, args);       }-      return (this->*Table_Formatted[label.function_num])(self, params, args);     }     return TypeValue::Dispatch(self, label, params, args);   }

@@ -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.@@ -43,7 +43,6 @@ class Category_Char; class Type_Char; class Value_Char;-S<TypeValue> CreateValue(Type_Char& parent, const ParamTuple& params, const ValueTuple& args); struct Category_Char : public TypeCategory {   std::string CategoryName() const final { return "Char"; }   Category_Char() {@@ -74,29 +73,38 @@     }     return true;   }+  void Params_Char(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsBool(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsChar(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsInt(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsFloat(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_Formatted(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }   bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {-    if (&category == &GetCategory_Char()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsBool()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsChar()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsInt()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsFloat()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_Formatted()) {-      args = std::vector<S<const TypeInstance>>{};+    using CallType = void(Type_Char::*)(std::vector<S<const TypeInstance>>&)const;+    static DispatchSingle<CallType> all_calls[] = {+      DispatchSingle<CallType>(&GetCategory_AsBool(),    &Type_Char::Params_AsBool),+      DispatchSingle<CallType>(&GetCategory_AsChar(),    &Type_Char::Params_AsChar),+      DispatchSingle<CallType>(&GetCategory_AsFloat(),   &Type_Char::Params_AsFloat),+      DispatchSingle<CallType>(&GetCategory_AsInt(),     &Type_Char::Params_AsInt),+      DispatchSingle<CallType>(&GetCategory_Char(),      &Type_Char::Params_Char),+      DispatchSingle<CallType>(&GetCategory_Formatted(), &Type_Char::Params_Formatted),+      DispatchSingle<CallType>(),+    };+    const DispatchSingle<CallType>* const call = DispatchSelect(&category, all_calls);+    if (call) {+      (this->*call->value)(args);       return true;     }     return false;@@ -118,24 +126,20 @@     static const CallType Table_LessThan[] = {       &Type_Char::Call_lessThan,     };-    if (label.collection == Functions_Default) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_Default,  Table_Default),+      DispatchTable<CallType>(Functions_Equals,   Table_Equals),+      DispatchTable<CallType>(Functions_LessThan, Table_LessThan),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(params, args);       }-      return (this->*Table_Default[label.function_num])(params, args);     }-    if (label.collection == Functions_Equals) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_Equals[label.function_num])(params, args);-    }-    if (label.collection == Functions_LessThan) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_LessThan[label.function_num])(params, args);-    }     return TypeInstance::Dispatch(self, label, params, args);   }   ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args);@@ -165,35 +169,21 @@     static const CallType Table_Formatted[] = {       &Value_Char::Call_formatted,     };-    if (label.collection == Functions_AsBool) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsBool[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsChar) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsChar[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsFloat) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsFloat[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsInt) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsInt[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_Formatted) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_AsBool,    Table_AsBool),+      DispatchTable<CallType>(Functions_AsChar,    Table_AsChar),+      DispatchTable<CallType>(Functions_AsFloat,   Table_AsFloat),+      DispatchTable<CallType>(Functions_AsInt,     Table_AsInt),+      DispatchTable<CallType>(Functions_Formatted, Table_Formatted),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(self, params, args);       }-      return (this->*Table_Formatted[label.function_num])(self, params, args);     }     return TypeValue::Dispatch(self, label, params, args);   }

@@ -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.@@ -42,7 +42,6 @@ class Category_Float; class Type_Float; class Value_Float;-S<TypeValue> CreateValue(Type_Float& parent, const ParamTuple& params, const ValueTuple& args); struct Category_Float : public TypeCategory {   std::string CategoryName() const final { return "Float"; }   Category_Float() {@@ -73,25 +72,34 @@     }     return true;   }+  void Params_Float(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsBool(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsInt(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsFloat(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_Formatted(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }   bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {-    if (&category == &GetCategory_Float()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsBool()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsInt()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsFloat()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_Formatted()) {-      args = std::vector<S<const TypeInstance>>{};+    using CallType = void(Type_Float::*)(std::vector<S<const TypeInstance>>&)const;+    static DispatchSingle<CallType> all_calls[] = {+      DispatchSingle<CallType>(&GetCategory_AsBool(),    &Type_Float::Params_AsBool),+      DispatchSingle<CallType>(&GetCategory_AsFloat(),   &Type_Float::Params_AsFloat),+      DispatchSingle<CallType>(&GetCategory_AsInt(),     &Type_Float::Params_AsInt),+      DispatchSingle<CallType>(&GetCategory_Float(),     &Type_Float::Params_Float),+      DispatchSingle<CallType>(&GetCategory_Formatted(), &Type_Float::Params_Formatted),+      DispatchSingle<CallType>(),+    };+    const DispatchSingle<CallType>* const call = DispatchSelect(&category, all_calls);+    if (call) {+      (this->*call->value)(args);       return true;     }     return false;@@ -113,24 +121,20 @@     static const CallType Table_LessThan[] = {       &Type_Float::Call_lessThan,     };-    if (label.collection == Functions_Default) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_Default,  Table_Default),+      DispatchTable<CallType>(Functions_Equals,   Table_Equals),+      DispatchTable<CallType>(Functions_LessThan, Table_LessThan),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(params, args);       }-      return (this->*Table_Default[label.function_num])(params, args);     }-    if (label.collection == Functions_Equals) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_Equals[label.function_num])(params, args);-    }-    if (label.collection == Functions_LessThan) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_LessThan[label.function_num])(params, args);-    }     return TypeInstance::Dispatch(self, label, params, args);   }   ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args);@@ -157,29 +161,20 @@     static const CallType Table_Formatted[] = {       &Value_Float::Call_formatted,     };-    if (label.collection == Functions_AsBool) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsBool[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsFloat) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsFloat[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsInt) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsInt[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_Formatted) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_AsBool,    Table_AsBool),+      DispatchTable<CallType>(Functions_AsFloat,   Table_AsFloat),+      DispatchTable<CallType>(Functions_AsInt,     Table_AsInt),+      DispatchTable<CallType>(Functions_Formatted, Table_Formatted),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(self, params, args);       }-      return (this->*Table_Formatted[label.function_num])(self, params, args);     }     return TypeValue::Dispatch(self, label, params, args);   }

@@ -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.@@ -43,7 +43,6 @@ class Category_Int; class Type_Int; class Value_Int;-S<TypeValue> CreateValue(Type_Int& parent, const ParamTuple& params, const ValueTuple& args); struct Category_Int : public TypeCategory {   std::string CategoryName() const final { return "Int"; }   Category_Int() {@@ -74,29 +73,38 @@     }     return true;   }+  void Params_Int(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsBool(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsChar(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsInt(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsFloat(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_Formatted(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }   bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {-    if (&category == &GetCategory_Int()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsBool()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsChar()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsInt()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsFloat()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_Formatted()) {-      args = std::vector<S<const TypeInstance>>{};+    using CallType = void(Type_Int::*)(std::vector<S<const TypeInstance>>&)const;+    static DispatchSingle<CallType> all_calls[] = {+      DispatchSingle<CallType>(&GetCategory_AsBool(),    &Type_Int::Params_AsBool),+      DispatchSingle<CallType>(&GetCategory_AsChar(),    &Type_Int::Params_AsChar),+      DispatchSingle<CallType>(&GetCategory_AsFloat(),   &Type_Int::Params_AsFloat),+      DispatchSingle<CallType>(&GetCategory_AsInt(),     &Type_Int::Params_AsInt),+      DispatchSingle<CallType>(&GetCategory_Formatted(), &Type_Int::Params_Formatted),+      DispatchSingle<CallType>(&GetCategory_Int(),       &Type_Int::Params_Int),+      DispatchSingle<CallType>(),+    };+    const DispatchSingle<CallType>* const call = DispatchSelect(&category, all_calls);+    if (call) {+      (this->*call->value)(args);       return true;     }     return false;@@ -118,24 +126,20 @@     static const CallType Table_LessThan[] = {       &Type_Int::Call_lessThan,     };-    if (label.collection == Functions_Default) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_Default,  Table_Default),+      DispatchTable<CallType>(Functions_Equals,   Table_Equals),+      DispatchTable<CallType>(Functions_LessThan, Table_LessThan),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(params, args);       }-      return (this->*Table_Default[label.function_num])(params, args);     }-    if (label.collection == Functions_Equals) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_Equals[label.function_num])(params, args);-    }-    if (label.collection == Functions_LessThan) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_LessThan[label.function_num])(params, args);-    }     return TypeInstance::Dispatch(self, label, params, args);   }   ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args);@@ -165,35 +169,21 @@     static const CallType Table_Formatted[] = {       &Value_Int::Call_formatted,     };-    if (label.collection == Functions_AsBool) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsBool[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsChar) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsChar[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsFloat) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsFloat[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_AsInt) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_AsInt[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_Formatted) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_AsBool,    Table_AsBool),+      DispatchTable<CallType>(Functions_AsChar,    Table_AsChar),+      DispatchTable<CallType>(Functions_AsFloat,   Table_AsFloat),+      DispatchTable<CallType>(Functions_AsInt,     Table_AsInt),+      DispatchTable<CallType>(Functions_Formatted, Table_Formatted),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(self, params, args);       }-      return (this->*Table_Formatted[label.function_num])(self, params, args);     }     return TypeValue::Dispatch(self, label, params, args);   }

@@ -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.@@ -31,6 +31,8 @@ #include "Category_Append.hpp" #include "Category_Build.hpp" #include "Category_Default.hpp"+#include "Category_DefaultOrder.hpp"+#include "Category_Order.hpp" #include "Category_Equals.hpp" #include "Category_LessThan.hpp" @@ -48,7 +50,6 @@ class Category_String; class Type_String; class Value_String;-S<TypeValue> CreateValue(Type_String& parent, const ParamTuple& params, const ValueTuple& args); struct Category_String : public TypeCategory {   std::string CategoryName() const final { return "String"; }   Category_String() {@@ -79,21 +80,38 @@     }     return true;   }+  void Params_String(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_AsBool(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_Formatted(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_ReadAt(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{GetType_Char(T_get())};+  }+  void Params_SubSequence(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{};+  }+  void Params_DefaultOrder(std::vector<S<const TypeInstance>>& args) const {+    args = std::vector<S<const TypeInstance>>{GetType_Char(T_get())};+  }   bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {-    if (&category == &GetCategory_String()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_AsBool()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_Formatted()) {-      args = std::vector<S<const TypeInstance>>{};-      return true;-    }-    if (&category == &GetCategory_ReadAt()) {-      args = std::vector<S<const TypeInstance>>{GetType_Char(T_get())};+    using CallType = void(Type_String::*)(std::vector<S<const TypeInstance>>&)const;+    static DispatchSingle<CallType> all_calls[] = {+      DispatchSingle<CallType>(&GetCategory_String(),       &Type_String::Params_String),+      DispatchSingle<CallType>(&GetCategory_AsBool(),       &Type_String::Params_AsBool),+      DispatchSingle<CallType>(&GetCategory_Formatted(),    &Type_String::Params_Formatted),+      DispatchSingle<CallType>(&GetCategory_ReadAt(),       &Type_String::Params_ReadAt),+      DispatchSingle<CallType>(&GetCategory_SubSequence(),  &Type_String::Params_SubSequence),+      DispatchSingle<CallType>(&GetCategory_DefaultOrder(), &Type_String::Params_DefaultOrder),+      DispatchSingle<CallType>(),+    };+    const DispatchSingle<CallType>* const call = DispatchSelect(&category, all_calls);+    if (call) {+      (this->*call->value)(args);       return true;     }     return false;@@ -118,30 +136,21 @@     static const CallType Table_String[] = {       &Type_String::Call_builder,     };-    if (label.collection == Functions_Default) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_Default,  Table_Default),+      DispatchTable<CallType>(Functions_Equals,   Table_Equals),+      DispatchTable<CallType>(Functions_LessThan, Table_LessThan),+      DispatchTable<CallType>(Functions_String,   Table_String),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(params, args);       }-      return (this->*Table_Default[label.function_num])(params, args);     }-    if (label.collection == Functions_Equals) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_Equals[label.function_num])(params, args);-    }-    if (label.collection == Functions_LessThan) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_LessThan[label.function_num])(params, args);-    }-    if (label.collection == Functions_String) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_String[label.function_num])(params, args);-    }     return TypeInstance::Dispatch(self, label, params, args);   }   ReturnTuple Call_default(const ParamTuple& params, const ValueTuple& args);@@ -160,6 +169,9 @@     static const CallType Table_AsBool[] = {       &Value_String::Call_asBool,     };+    static const CallType Table_DefaultOrder[] = {+      &Value_String::Call_defaultOrder,+    };     static const CallType Table_Formatted[] = {       &Value_String::Call_formatted,     };@@ -175,48 +187,31 @@     static const CallType Table_SubSequence[] = {       &Value_String::Call_subSequence,     };-    if (label.collection == Functions_AsBool) {-      if (label.function_num < 0 || label.function_num >= 1) {+    static DispatchTable<CallType> all_tables[] = {+      DispatchTable<CallType>(Functions_AsBool,       Table_AsBool),+      DispatchTable<CallType>(Functions_Container,    Table_Container),+      DispatchTable<CallType>(Functions_DefaultOrder, Table_DefaultOrder),+      DispatchTable<CallType>(Functions_Formatted,    Table_Formatted),+      DispatchTable<CallType>(Functions_ReadAt,       Table_ReadAt),+      DispatchTable<CallType>(Functions_String,       Table_String),+      DispatchTable<CallType>(Functions_SubSequence,  Table_SubSequence),+      DispatchTable<CallType>(),+    };+    const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);+    if (table) {+      if (label.function_num < 0 || label.function_num >= table->size) {         FAIL() << "Bad function call " << label;+      } else {+        return (this->*table->table[label.function_num])(self, params, args);       }-      return (this->*Table_AsBool[label.function_num])(self, params, args);     }-    if (label.collection == Functions_Formatted) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_Formatted[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_ReadAt) {-      if (label.function_num < 0 || label.function_num >= 2) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_ReadAt[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_Container) {-      if (label.function_num < 0 || label.function_num >= 2) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_Container[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_String) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_String[label.function_num])(self, params, args);-    }-    if (label.collection == Functions_SubSequence) {-      if (label.function_num < 0 || label.function_num >= 1) {-        FAIL() << "Bad function call " << label;-      }-      return (this->*Table_SubSequence[label.function_num])(self, params, args);-    }     return TypeValue::Dispatch(self, label, params, args);   }   std::string CategoryName() const final { return parent->CategoryName(); }   const PrimString& AsString() const final { return value_; }   ReturnTuple Call_asBool(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);   ReturnTuple Call_formatted(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);+  ReturnTuple Call_defaultOrder(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);   ReturnTuple Call_readAt(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);   ReturnTuple Call_size(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);   ReturnTuple Call_subSequence(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);@@ -256,6 +251,28 @@   std::ostringstream output_; }; +struct StringOrder : public AnonymousOrder {+  StringOrder(S<TypeValue> container, const std::string& s)+    : AnonymousOrder(container, Function_Order_next, Function_Order_get), value(s) {}++  S<TypeValue> Call_next(const S<TypeValue>& self) final {+    if (index+1 >= value.size()) {+      return Var_empty;+    } else {+      ++index;+      return self;+    }+  }++  S<TypeValue> Call_get(const S<TypeValue>& self) final {+    if (index >= value.size()) FAIL() << "iterated past end of String";+    return Box_Char(value[index]);+  }++  const std::string& value;+  int index = 0;+};+ ReturnTuple Type_String::Call_default(const ParamTuple& params, const ValueTuple& args) {   TRACE_FUNCTION("String.default")   return ReturnTuple(Box_String(""));@@ -283,6 +300,14 @@ ReturnTuple Value_String::Call_formatted(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {   TRACE_FUNCTION("String.formatted")   return ReturnTuple(Var_self);+}+ReturnTuple Value_String::Call_defaultOrder(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+  TRACE_FUNCTION("String.defaultOrder")+  if (value_.empty()) {+    return ReturnTuple(Var_empty);+  } else {+    return ReturnTuple(S_get(new StringOrder(Var_self, value_)));+  } } ReturnTuple Value_String::Call_readAt(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {   TRACE_FUNCTION("String.readAt")

@@ -93,6 +93,7 @@ // Literals: Quote Char sequence with ". concrete String {   refines AsBool+  refines DefaultOrder<Char>   refines Formatted   refines ReadAt<Char>   refines SubSequence@@ -155,6 +156,36 @@ @value interface Build<|#x> {   // Build and return a value from the current state.   build () -> (#x)+}++// Ordered data, primarily used for the traverse built-in.+//+// Example:+//+//   traverse (someIntOrder -> Int i) {+//     // code that uses index i+//   }+@value interface Order<|#x> {+  // Returns an updated instance, or empty if the end was reached.+  //+  // Notes:+  // - This can return either a mutated self or a new copy. The caller should+  //   assume that next() will mutate the instance.+  // - This should not generally be used directly; use the traverse built-in.+  next () -> (optional #self)++  // Returns the value at the current position.+  get () -> (#x)+}++// Provides a default Order for a container.+//+// Notes:+// - The return value is primarily intended for use with the traverse built-in.+// - Also see the documentation for Order and traverse.+@value interface DefaultOrder<|#x> {+  // Returns the default Order for the container.+  defaultOrder () -> (optional Order<#x>) }  // Contains a flexible number of values of some type.

@@ -1,5 +1,5 @@ /* ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -30,9 +30,5 @@ class CategoryFunction; class TypeFunction; class ValueFunction;--#if defined(ZEOLITE_PUBLIC_NAMESPACE) && !defined(ZEOLITE_DYNAMIC_NAMESPACE)-#define ZEOLITE_DYNAMIC_NAMESPACE ZEOLITE_PUBLIC_NAMESPACE-#endif  #endif  // CATEGORY_HEADER_HPP_

@@ -269,3 +269,24 @@ bool TypeValue::Present() const {   return true; }++AnonymousOrder::AnonymousOrder(const S<TypeValue> cont,+                               const ValueFunction& func_next,+                               const ValueFunction& func_get)+  : container(cont), function_next(func_next), function_get(func_get) {}++std::string AnonymousOrder::CategoryName() const { return "AnonymousOrder"; }++ReturnTuple AnonymousOrder::Dispatch(+  const S<TypeValue>& self, const ValueFunction& label,+  const ParamTuple& params, const ValueTuple& args) {+  if (&label == &function_next) {+    TRACE_FUNCTION("AnonymousOrder.next")+    return ReturnTuple(Call_next(self));+  }+  if (&label == &function_get) {+    TRACE_FUNCTION("AnonymousOrder.get")+    return ReturnTuple(Call_get(self));+  }+  return TypeValue::Dispatch(self, label, params, args);+}

@@ -19,6 +19,7 @@ #ifndef CATEGORY_SOURCE_HPP_ #define CATEGORY_SOURCE_HPP_ +#include <algorithm> #include <iostream>  // For occasional debugging output in generated code. #include <map> #include <mutex>@@ -214,5 +215,77 @@   std::mutex mutex_;   std::map<typename ParamsKey<P>::Type, S<T>> cache_; };++class AnonymousOrder : public TypeValue {+ protected:+  // Passing in the function labels allows linking without depending on Order+  // when this class isn't used anywhere.+  AnonymousOrder(const S<TypeValue> cont,+                 const ValueFunction& func_next,+                 const ValueFunction& func_get);++  std::string CategoryName() const final;+  ReturnTuple Dispatch(const S<TypeValue>& self,+                       const ValueFunction& label,+                       const ParamTuple& params,+                       const ValueTuple& args) final;++  virtual ~AnonymousOrder() = default;++ private:+  virtual S<TypeValue> Call_next(const S<TypeValue>& self) = 0;+  virtual S<TypeValue> Call_get(const S<TypeValue>& self) = 0;++  const S<TypeValue> container;+  const ValueFunction& function_next;+  const ValueFunction& function_get;+};++template<class F>+struct DispatchTable {+  constexpr DispatchTable() : key(nullptr), table(nullptr), size(0) {}++  template<int S>+  DispatchTable(const void* k, const F(&t)[S]) : key(k), table(t), size(S) {}++  bool operator < (const DispatchTable<F>& other) const { return key < other.key; }++  const void* key;+  const F* table;+  int size;+};++template<class F>+struct DispatchSingle {+  constexpr DispatchSingle() : key(nullptr), value() {}++  DispatchSingle(const void* k, const F v) : key(k), value(v) {}++  bool operator < (const DispatchSingle<F>& other) const { return key < other.key; }++  const void* key;+  F value;+  int size;+};++template<class T, int S>+const T* DispatchSelect(const void* key, T(&table)[S]) {+  if (S < 2) return nullptr;+  if (table[0].key != nullptr) {+    std::sort(table, table+S);+  }+  int i = 1, j = S;+  while (j-i > 1) {+    const int k = (i+j)/2;+    if (table[k].key < key) {+      i = k;+    } else if (table[k].key > key) {+      j = k;+    } else {+      return &table[k];+    }+  }+  return (table[i].key == key)? &table[i] : nullptr;+}  #endif  // CATEGORY_SOURCE_HPP_

@@ -19,7 +19,9 @@ #include "logging.hpp"  #include <cassert>+#include <chrono> #include <csignal>+#include <iomanip> #include <iostream>  @@ -116,6 +118,7 @@  void SourceContext::SetLocal(const char* at) {   at_ = at;+  LogCalls::MaybeLogCall(name_, at_); }  void SourceContext::AppendTrace(TraceList& trace) const {@@ -177,4 +180,55 @@  const std::vector<std::string>& ProgramArgv::GetArgs() const {   return argv_;+}++std::string FixCsvString(const char* string) {+  std::string fixed;+  while (*string) {+    switch (*string) {+      case '\\':+        break;+      case '"':+        fixed.push_back('\'');+        break;+      default:+        fixed.push_back(*string);+        break;+    }+    ++string;+  }+  return fixed;+}++unsigned int UniqueId() {+  const auto time = std::chrono::steady_clock::now().time_since_epoch();+  return (1000000009 * std::chrono::duration_cast<std::chrono::microseconds>(time).count());+}++LogCallsToFile::LogCallsToFile(std::string filename)+  : unique_id_(UniqueId()),+    filename_(std::move(filename)),+    log_file_(filename_.empty()?+                nullptr :+                new std::fstream(filename_, std::ios::in |+                                            std::ios::out |+                                            std::ios::ate |+                                            std::ios::app)),+    cross_and_capture_to_(this) {+  if (log_file_) {+    if (!*log_file_) {+      FAIL() << "Failed to open call log " << filename_ << " for writing";+    }+  }+}++void LogCallsToFile::LogCall(const char* name, const char* at) {+  if (log_file_) {+    std::lock_guard<std::mutex> lock(mutex_);+    const auto time = std::chrono::steady_clock::now().time_since_epoch();+    *log_file_ << std::chrono::duration_cast<std::chrono::microseconds>(time).count() << ","+               << unique_id_ << ","+               << "\"" << FixCsvString(name) << "\"" << ","+               << "\"" << FixCsvString(at) << "\"" << std::endl;+  } }

@@ -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.@@ -20,7 +20,10 @@ #define LOGGING_HPP_  #include <functional>+#include <fstream> #include <list>+#include <memory>+#include <mutex> #include <sstream> #include <string> #include <vector>@@ -78,11 +81,11 @@   #define PRED_CONTEXT_POINT(point) \     TraceContext::SetContext(point), -  #define CAPTURE_CREATION \-    CreationTrace creation_context_;+  #define CAPTURE_CREATION(name) \+    CreationTrace creation_context_ = name;    #define TRACE_CREATION \-    TraceCreation trace_creation(TypeInstance::TypeName(parent), creation_context_);+    TraceCreation trace_creation(creation_context_);    #define FAIL_WHEN_NULL(value) \     FailWhenNull(value)@@ -171,35 +174,43 @@ class ProgramArgv : public Argv {  public:   inline ProgramArgv(int argc, const char** argv)-    : argv_(argv, argv + argc), capture_to_(this) {}+    : argv_(argv, argv + argc), cross_and_capture_to_(this) {}   private:   const std::vector<std::string>& GetArgs() const final;    const std::vector<std::string> argv_;-  const ScopedCapture capture_to_;+  const AutoThreadCrosser cross_and_capture_to_; };  class CreationTrace {  public:-  inline CreationTrace() : trace_(TraceContext::GetTrace()) {}+  // NOTE: Using a template with [] here breaks inline member initialization+  // when using CAPTURE_CREATION in g++.+  inline CreationTrace(const char* type)+    : type_(type), trace_(TraceContext::GetTrace()) {} +  inline std::string GetType() const {+    return type_;+  }+   inline const TraceList& GetTrace() const {     return trace_;   }   private:+  const char* const type_;   const TraceList trace_; };  class TraceCreation : public capture_thread::ThreadCapture<TraceCreation> {  public:-  inline TraceCreation(std::string type, const CreationTrace& trace)-    : type_(type), trace_(trace), capture_to_(this) {}+  inline TraceCreation(const CreationTrace& trace)+    : trace_(trace), capture_to_(this) {}    static inline std::string GetType() {     if (GetCurrent()) {-      return GetCurrent()->type_;+      return GetCurrent()->trace_.GetType();     } else {       return std::string();     }@@ -214,10 +225,37 @@   }   private:--  const std::string type_;   const CreationTrace& trace_;   const ScopedCapture capture_to_;+};++class LogCalls : public capture_thread::ThreadCapture<LogCalls> {+ public:+  static inline void MaybeLogCall(const char* name, const char* at) {+    if (GetCurrent()) {+      GetCurrent()->LogCall(name, at);+    }+  }++ protected:+  virtual ~LogCalls() = default;++ private:+  virtual void LogCall(const char* name, const char* at) = 0;+};++class LogCallsToFile : public LogCalls {+ public:+  LogCallsToFile(std::string filename);++ private:+  void LogCall(const char* name, const char* at) final;++  std::mutex mutex_;+  const unsigned int unique_id_;+  const std::string& filename_;+  const std::unique_ptr<std::fstream> log_file_;+  const AutoThreadCrosser cross_and_capture_to_; };  #endif  // LOGGING_HPP_

@@ -9,20 +9,16 @@     }     String message <- "Failed to match \"" + match + "\" at " + contextOld.getPosition()     ParseContext<any> context <- contextOld-    scoped {-      Int index <- 0-    } in while (index < match.size()) {-      $ReadOnly[context,index]$+    traverse (Counter.zeroIndexed(match.size()) -> Int index) {+      $ReadOnly[index]$       if (context.atEof() || context.current() != match.readAt(index)) {         if (index > 0) {           // Partial match => set error context.           return context.setBrokenInput(message)         } else {-          return context.setValue<all>(ErrorOr:error(message))+          return context.setValue<?>(ErrorOr:error(message))         }       }-    } update {-      index <- index+1       context <- context.advance()     }     return context.setValue<?>(ErrorOr:value<?>(match))@@ -49,27 +45,32 @@                       contextOld.getPosition()     ParseContext<any> context <- contextOld     [Append<String>&Build<String>] builder <- String.builder()++    optional Order<Int> counter <- empty+    if (max == 0) {+      counter <- Counter.unlimited()+    } else {+      counter <- Counter.zeroIndexed(max)+    }+     Int count <- 0-    while (!context.atEof() && (max == 0 || count < max)) {-      $ReadOnly[context,count]$+    traverse (counter -> count) {+      $Hidden[count,counter]$+      if (context.atEof()) {+        break+      }       Bool found <- false-      scoped {-        Int index <- 0-      } in while (index < matches.size()) {-        $ReadOnly[index]$+      traverse (Counter.zeroIndexed(matches.size()) -> Int index) {+        $ReadOnly[context,index]$         if (context.current() == matches.readAt(index)) {           \ builder.append(matches.readAt(index).formatted())           found <- true           break         }-      } update {-        index <- index+1       }       if (!found) {         break       }-    } update {-      count <- count+1       context <- context.advance()     }     if (count >= min) {@@ -78,7 +79,7 @@       // Partial match => set error context.       return context.setBrokenInput(message)     } else {-      return context.setValue<all>(ErrorOr:error(message))+      return context.setValue<?>(ErrorOr:error(message))     }   } @@ -98,7 +99,7 @@     }     if (contextOld.atEof() || contextOld.current() != match) {       String message <- "Failed to match '" + match.formatted() + "' at " + contextOld.getPosition()-      return contextOld.setValue<all>(ErrorOr:error(message))+      return contextOld.setValue<?>(ErrorOr:error(message))     } else {       return contextOld.advance().setValue<?>(ErrorOr:value<?>(match))     }@@ -137,7 +138,7 @@   @value Formatted message    run (contextOld) {-    return contextOld.setValue<all>(ErrorOr:error(message))+    return contextOld.setValue<?>(ErrorOr:error(message))   }    create (message) {@@ -160,7 +161,7 @@     }     ParseContext<#x> context <- contextOld.run<#x>(parser)     if (context.hasAnyError()) {-      return contextOld.setValue<all>(context.getValue().convertError())+      return contextOld.setValue<?>(context.getValue().convertError())     } else {       return context.toState()     }@@ -216,7 +217,7 @@     if (context.hasAnyError()) {       return context.toState()     } else {-      ParseContext<any> context2 <- context.run<any>(parser2)+      ParseContext<any> context2 <- context.run<?>(parser2)       if (context2.hasAnyError()) {         return context2.convertError()       } else {@@ -244,7 +245,7 @@     if (contextOld.hasAnyError()) {       return contextOld.convertError()     }-    ParseContext<any> context <- contextOld.run<any>(parser1)+    ParseContext<any> context <- contextOld.run<?>(parser1)     if (context.hasAnyError()) {       return context.convertError()     } else {

@@ -23,6 +23,25 @@ }  define TestDataParser {+  // Mark @category members as read-only, to avoid accidental assignment.+  $ReadOnly[sentenceOrToken,+            acronymOrAardvark,+            fileStart,+            fileEnd,+            nameTag,+            descriptionTag,+            aWordTag]$++  // Mark @category members as hidden, since they should not be used directly.+  $Hidden[whitespace,+          sentenceChars,+          sentence,+          quote,+          quotedSentence,+          token,+          acronym,+          aardvark]$+   refines Parser<TestData>    @category Parser<any> whitespace <- SequenceOfParser.create(" \n\t",1,0) `Parse.or<?>` Parse.error("Expected whitespace")

@@ -0,0 +1,11 @@+root: "../.."+path: "example/primes"+private_deps: [+  "lib/container"+  "lib/thread"+  "lib/util"+]+mode: binary {+  category: PrimesDemo+  function: run+}

@@ -0,0 +1,57 @@+# Zeolite Primes Example++*Also see+[a highlighted version of the example code](https://ta0kira.github.io/zeolite/example/primes).*++This example demonstrates synchronizing two threads using `lib/thread`.++## Notes++There are two threads in this program:++1. The main thread, which deals with user input.+2. The computation thread, which is controlled by the main thread.++When the program starts, the computation thread is stopped, and the main thread+is waiting for user input. Follow the prompts to start, stop, and cancel the+computation thread. The program will print the prime numbers computed during the+time that the computation thread was running.++A few specific points about the example:++- See `flag.0rx` for an example of how `ConditionWait` and `ConditionResume`+  (from `lib/thread`) can be used to start and stop a thread process. (Also+  notice that it uses the type intersection `[ConditionWait&ConditionResume]`.)++- `prime-tracker.0rx` uses both the `$ReadOnly[...]$` and `$Hidden[...]$`+  pragmas to cut down on possible errors when multiple variables of the same+  type are in scope.++- Other than the condition logic in `ThreadFlag`, the other categories in this+  example *are not* thread-safe. On the other hand, the main thread does not+  read or modify any shared state other than the `ThreadFlag` while the+  computation thread is running. Other approaches might require using `Mutex`es+  in other places.++## 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+# This is just to locate the example code. Not for normal use!+ZEOLITE_PATH=$(zeolite --get-path)++# Compile the example.+zeolite -p "$ZEOLITE_PATH" -r example/primes++# Execute the compiled binary.+$ZEOLITE_PATH/example/primes/PrimesDemo+```

@@ -0,0 +1,32 @@+$ModuleOnly$++// A gate for starting, stopping, and canceling thread processes.+@value interface ThreadGate {+  // Start the thread(s).+  start () -> (#self)++  // Stop the thread(s).+  stop () -> (#self)++  // Returns true iff the thread(s) should be running.+  getEnabled () -> (Bool)++  // Permanently cancel the thread(s).+  cancel () -> (#self)+}+++// Determine if a thread should continue or exit.+@value interface ThreadContinue {+  // Blocks until a start or cancel signal is received. If false is returned,+  // the thread should clean up and exit.+  shouldContinue () -> (Bool)+}++// Implementation of thread gating with a flag.+concrete ThreadFlag {+  refines ThreadGate+  refines ThreadContinue++  @type new () -> (ThreadFlag)+}

@@ -0,0 +1,64 @@+define ThreadFlag {+  @value [ConditionWait&ConditionResume] cond+  @value Bool enabled+  @value Bool canceled++  new () {+    return ThreadFlag{ ThreadCondition.new(), false, false }+  }++  start () {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+    } cleanup {+      \ lock.freeResource()+    } in enabled <- true+    \ cond.resumeAll()+    return self+  }++  stop () {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+    } cleanup {+      \ lock.freeResource()+    } in enabled <- false+    return self+  }++  getEnabled () {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+    } cleanup {+      \ lock.freeResource()+    } in return enabled && !canceled+  }++  cancel () {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+    } cleanup {+      \ lock.freeResource()+    } in canceled <- true+    \ cond.resumeAll()+    return self+  }++  shouldContinue () {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+    } cleanup {+      \ lock.freeResource()+    } in while (true) {+      if (canceled) {+        return false+      } elif (enabled) {+        break+      } else {+        // The Mutex associated with cond is unlocked during wait().+        \ cond.wait()+      }+    }+    return true+  }+}

@@ -0,0 +1,8 @@+$ModuleOnly$++// Repeatedly checks the next possible prime until canceled.+concrete PrimeThread {+  refines Routine++  @type create (ThreadContinue,PrimeTracker) -> (PrimeThread)+}

@@ -0,0 +1,14 @@+define PrimeThread {+  @value ThreadContinue flag+  @value PrimeTracker   tracker++  create (flag,tracker) {+    return PrimeThread{ flag, tracker }+  }++  run () {+    while (flag.shouldContinue()) {+      \ tracker.checkNextPossible(flag)+    }+  }+}

@@ -0,0 +1,9 @@+$ModuleOnly$++// Incrementally tracks primes.+concrete PrimeTracker {+  @type create () -> (PrimeTracker)+  @value checkNextPossible (ThreadContinue) -> (#self)+  // optional Order<Int> can be used with the traverse built-in for iteration.+  @value getResults () -> (optional Order<Int>)+}

@@ -0,0 +1,46 @@+define PrimeTracker {+  @value Vector<Int> primes+  @value Int nextPossible++  create () {+    return PrimeTracker{ Vector:create<Int>(), 2 }+  }++  checkNextPossible (flag) {+    Int toCheck <- nextPossible+    $ReadOnly[toCheck]$++    Bool isPrime <- true++    traverse (getResults() -> Int prime) {+      $ReadOnly[prime]$+      $Hidden[nextPossible]$+      if (!flag.shouldContinue()) {+        return self+      }+      if (toCheck%prime == 0) {+        isPrime <- false+        break+      }+      if (prime*prime >= toCheck) {+        break+      }+    }+    // Postpone updating the next possible until we know that there wasn't an+    // early return due to the flag.+    nextPossible <- nextPossible+1++    if (isPrime) {+      \ LazyStream<Formatted>.new()+          .append("\r")+          .append(toCheck)+          .writeTo(SimpleOutput.stderr())+      \ primes.push(toCheck)+    }+    return self+  }++  getResults () {+    return primes.defaultOrder()+  }+}

@@ -0,0 +1,62 @@+concrete PrimesDemo {+  @type run () -> ()+}++define PrimesDemo {+  run () {+    PrimeTracker tracker <- PrimeTracker.create()+    ThreadFlag flag <- ThreadFlag.new()+    Thread thread <- ProcessThread.from(PrimeThread.create(flag,tracker)).start()++    // Interactive input loop.++    scoped {+      TextReader reader <- TextReader.fromBlockReader(SimpleInput.stdin())+    } in while (!reader.pastEnd()) {+      $Hidden[tracker,thread]$++      \ LazyStream<Formatted>.new()+          .append("Press [Enter] to toggle start/stop computation thread. Type \"exit\" to exit.\n")+          .writeTo(SimpleOutput.stderr())+      String input <- reader.readNextLine()+      if (reader.pastEnd()) {+        break+      }++      if (input == "") {+        if (flag.getEnabled()) {+          \ flag.stop()+          \ LazyStream<Formatted>.new()+              .append("Stopped.\n")+              .writeTo(SimpleOutput.stderr())+        } else {+          \ flag.start()+          \ LazyStream<Formatted>.new()+              .append("Started.\n")+              .writeTo(SimpleOutput.stderr())+        }+      } elif (input == "exit") {+        break+      } else {+        \ LazyStream<Formatted>.new()+            .append("Please try again!\n")+            .writeTo(SimpleOutput.stderr())+      }+    }++    // Wait for the thread to exit, then print the results.++    \ flag.cancel()+    \ LazyStream<Formatted>.new()+        .append("Exiting.\n")+        .writeTo(SimpleOutput.stderr())+    \ thread.join()++    traverse (tracker.getResults() -> Int prime) {+      \ LazyStream<Formatted>.new()+          .append(prime)+          .append("\n")+          .writeTo(SimpleOutput.stdout())+    }+  }+}

@@ -50,3 +50,16 @@   // Returns the value associated with the key if present.   get (#k) -> (optional #v) }++// A single key-value pair from a KVReader.+@value interface KeyValue<|#k,#v> {+  // Get the key.+  //+  // Notes:+  // - Calling mutating functions on the key could invalidate the structure of+  //   the KVReader.+  getKey () -> (#k)++  // Get the value.+  getValue () -> (#v)+}

@@ -22,12 +22,30 @@ // - #k: The key type. // - #v: The value type. concrete SearchTree<#k,#v> {+  refines DefaultOrder<KeyValue<#k,#v>>   refines KVWriter<#k,#v>   refines KVReader<#k,#v>   #k defines LessThan<#k>    // Create an empty tree.   @type new () -> (#self)++  // Traverse the tree in the reverse order of defaultOrder().+  //+  // Notes:+  // - Traversal of the entire tree is amortized O(n); however, the cost of any+  //   particular iteration could be up to O(log n).+  // - The overall memory cost is O(log n).+  @value reverseOrder () -> (optional Order<KeyValue<#k,#v>>)++  // Traverse in the default order.+  //+  // Notes:+  // - This is from DefaultOrder, but is made explicit for documentation.+  // - Traversal of the entire tree is amortized O(n); however, the cost of any+  //   particular iteration could be up to O(log n).+  // - The overall memory cost is O(log n).+  @value defaultOrder () -> (optional Order<KeyValue<#k,#v>>) }  // A validated binary search tree for key-value storage.@@ -40,7 +58,7 @@ // - This is the same as SearchTree, but it validates the tree structure every //   time there is a modification, which is extremely inefficient. This should //   therefore only be used in tests.-concrete ValidatedTree<#k,#v> {+concrete ValidatedTree<#k|#v|> {   refines KVWriter<#k,#v>   refines KVReader<#k,#v>   #k defines LessThan<#k>

@@ -16,11 +16,11 @@  // Author: Kevin P. Barry [ta0kira@gmail.com] -testcase "integration test" {+testcase "SearchTree tests" {   success } -unittest test {+unittest integrationTest {   [KVWriter<Int,Int>&KVReader<Int,Int>] tree <- ValidatedTree<Int,Int>.new()   Int count <- 30 @@ -61,4 +61,48 @@   } update {     i <- i+1   }+}++unittest defaultOrder {+  SearchTree<Int,Int> tree <- SearchTree<Int,Int>.new()+  Int hash <- 13+  Int max  <- 20+  $ReadOnly[hash,max]$++  // Populate the tree in a pseudo-random order.+  traverse (Counter.zeroIndexed(max) -> Int i) {+    \ ((i*hash)%max) `tree.set` i+  }++  // Validate the traversal order.+  Int index <- 0+  traverse (tree.defaultOrder() -> KeyValue<Int,Int> entry) {+    \ Testing.checkEquals<?>(entry.getKey(),index)+    \ Testing.checkEquals<?>((entry.getValue()*hash)%max,entry.getKey())+    index <- index+1+  }++  \ Testing.checkEquals<?>(index,20)+}++unittest reverseOrder {+  SearchTree<Int,Int> tree <- SearchTree<Int,Int>.new()+  Int hash <- 13+  Int max  <- 20+  $ReadOnly[hash,max]$++  // Populate the tree in a pseudo-random order.+  traverse (Counter.zeroIndexed(max) -> Int i) {+    \ ((i*hash)%max) `tree.set` i+  }++  // Validate the traversal order.+  Int index <- 20+  traverse (tree.reverseOrder() -> KeyValue<Int,Int> entry) {+    index <- index-1+    \ Testing.checkEquals<?>(entry.getKey(),index)+    \ Testing.checkEquals<?>((entry.getValue()*hash)%max,entry.getKey())+  }++  \ Testing.checkEquals<?>(index,0) }

@@ -36,6 +36,14 @@   get (k) {     return Node<#k,#v>.find(root,k)   }++  defaultOrder () {+    return ForwardTreeOrder:create<?,?>(root)+  }++  reverseOrder () {+    return ReverseTreeOrder:create<?,?>(root)+  } }  define ValidatedTree {@@ -69,6 +77,11 @@   @type delete (optional Node<#k,#v>,#k) -> (optional Node<#k,#v>)   @type find (optional Node<#k,#v>,#k) -> (optional #v)   @type validate (optional Node<#k,#v>) -> ()++  @value getLower () -> (optional Node<#k,#v>)+  @value getHigher () -> (optional Node<#k,#v>)+  @value getKey () -> (#k)+  @value getValue () -> (#v) }  define Node {@@ -134,6 +147,14 @@     }   } +  getLower () { return lower }++  getHigher () { return higher }++  getKey () { return key }++  getValue () { return value }+   @value validateOrder () -> ()   validateOrder () {     if (present(lower)) {@@ -303,29 +324,121 @@   @value getHeight () -> (Int)   getHeight () { return height } -  // It is unsafe to change the key after construction, so there is no setter.-  //-  // Unlike other languages, a member is only accessible by the value that owns-  // it. More specifically, @type functions in Node can only access @value-  // members via explicit @value getters and setters.-  @value getKey () -> (#k)-  getKey () { return key }--  @value getValue () -> (#v)-  getValue () { return value }-   @value setValue (#v) -> ()   setValue (v) { value <- v } -  @value getLower () -> (optional Node<#k,#v>)-  getLower () { return lower }-   @value setLower (optional Node<#k,#v>) -> ()   setLower (l) { lower <- l } -  @value getHigher () -> (optional Node<#k,#v>)-  getHigher () { return higher }-   @value setHigher (optional Node<#k,#v>) -> ()   setHigher (h) { higher <- h }+}++concrete TreeKeyValue<#k,#v> {+  refines KeyValue<#k,#v>++  @category create<#k,#v> (#k,#v) -> (TreeKeyValue<#k,#v>)+}++define TreeKeyValue {+  @value #k key+  @value #v value++  create (key,value) {+    return TreeKeyValue<#k,#v>{ key, value }+  }++  getKey () {+    return key+  }++  getValue () {+    return value+  }+}++concrete ForwardTreeOrder<#k,#v> {+  refines Order<KeyValue<#k,#v>>+  #k defines LessThan<#k>++  @category create<#k,#v>+    #k defines LessThan<#k>+  (optional Node<#k,#v>) -> (optional ForwardTreeOrder<#k,#v>)+}++define ForwardTreeOrder {+  $ReadOnly[node,prev]$++  @value Node<#k,#v> node+  @value optional ForwardTreeOrder<#k,#v> prev++  create (node) {+    optional Node<#k,#v> node2 <- node+    optional ForwardTreeOrder<#k,#v> current <- empty+    while (present(node2)) {+      current <- ForwardTreeOrder<#k,#v>{ require(node2), current }+      node2 <- require(node2).getLower()+    }+    return current+  }++  next () {+    // Algorithm:+    // 1. Pop self from the stack.+    // 2. Traverse lower to the bottom starting from the higher child of self.+    optional Node<#k,#v> node2 <- node.getHigher()+    optional ForwardTreeOrder<#k,#v> current <- prev+    while (present(node2)) {+      current <- ForwardTreeOrder<#k,#v>{ require(node2), current }+      node2 <- require(node2).getLower()+    }+    return current+  }++  get () {+    return TreeKeyValue:create<?,?>(node.getKey(),node.getValue())+  }+}++concrete ReverseTreeOrder<#k,#v> {+  refines Order<KeyValue<#k,#v>>+  #k defines LessThan<#k>++  @category create<#k,#v>+    #k defines LessThan<#k>+  (optional Node<#k,#v>) -> (optional ReverseTreeOrder<#k,#v>)+}++define ReverseTreeOrder {+  $ReadOnly[node,prev]$++  @value Node<#k,#v> node+  @value optional ReverseTreeOrder<#k,#v> prev++  create (node) {+    optional Node<#k,#v> node2 <- node+    optional ReverseTreeOrder<#k,#v> current <- empty+    while (present(node2)) {+      current <- ReverseTreeOrder<#k,#v>{ require(node2), current }+      node2 <- require(node2).getHigher()+    }+    return current+  }++  next () {+    // Algorithm:+    // 1. Pop self from the stack.+    // 2. Traverse higher to the bottom starting from the lower child of self.+    optional Node<#k,#v> node2 <- node.getLower()+    optional ReverseTreeOrder<#k,#v> current <- prev+    while (present(node2)) {+      current <- ReverseTreeOrder<#k,#v>{ require(node2), current }+      node2 <- require(node2).getHigher()+    }+    return current+  }++  get () {+    return TreeKeyValue:create<?,?>(node.getKey(),node.getValue())+  } }

@@ -24,7 +24,9 @@ #include "Category_Append.hpp" #include "Category_Container.hpp" #include "Category_Default.hpp"+#include "Category_DefaultOrder.hpp" #include "Category_Formatted.hpp"+#include "Category_Order.hpp" #include "Category_ReadAt.hpp" #include "Category_Stack.hpp" #include "Category_String.hpp"@@ -37,7 +39,7 @@  using VectorType = std::vector<S<TypeValue>>; -S<TypeValue> CreateValue_Vector(S<Type_Vector> parent, const ParamTuple& params, VectorType values);+S<TypeValue> CreateValue_Vector(S<Type_Vector> parent, VectorType values);  struct ExtCategory_Vector : public Category_Vector {   ReturnTuple Call_copyFrom(const ParamTuple& params, const ValueTuple& args) final {@@ -49,13 +51,13 @@     for (int i = 0; i < size; ++i) {       values.push_back(TypeValue::Call(Var_arg1, Function_ReadAt_readAt, ParamTuple(), ArgTuple(Box_Int(i))).Only());     }-    return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), ParamTuple(), values));+    return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), values));   }    ReturnTuple Call_create(const ParamTuple& params, const ValueTuple& args) final {     TRACE_FUNCTION("Vector:create")     const S<TypeInstance> Param_y = params.At(0);-    return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), ParamTuple(), VectorType()));+    return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), VectorType()));   }    ReturnTuple Call_createSize(const ParamTuple& params, const ValueTuple& args) final {@@ -66,7 +68,7 @@     for (int i = 0; i < Var_arg1; ++i) {       values.push_back(TypeInstance::Call(Param_y, Function_Default_default, ParamTuple(), ArgTuple()).Only());     }-    return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), ParamTuple(), values));+    return ReturnTuple(CreateValue_Vector(CreateType_Vector(Params<1>::Type(Param_y)), values));   } }; @@ -74,9 +76,31 @@   inline ExtType_Vector(Category_Vector& p, Params<1>::Type params) : Type_Vector(p, params) {} }; +struct VectorOrder : public AnonymousOrder {+  VectorOrder(S<TypeValue> container, const VectorType& v)+    : AnonymousOrder(container, Function_Order_next, Function_Order_get), values(v) {}++  S<TypeValue> Call_next(const S<TypeValue>& self) final {+    if (index+1 >= values.size()) {+      return Var_empty;+    } else {+      ++index;+      return self;+    }+  }++  S<TypeValue> Call_get(const S<TypeValue>& self) final {+    if (index >= values.size()) FAIL() << "iterated past end of Vector";+    return values[index];+  }++  const VectorType& values;+  int index = 0;+};+ struct ExtValue_Vector : public Value_Vector {-  inline ExtValue_Vector(S<Type_Vector> p, const ParamTuple& params, VectorType v)-    : Value_Vector(p, params), values(std::move(v)) {}+  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 {     TRACE_FUNCTION("Vector.append")@@ -86,6 +110,15 @@     return ReturnTuple(Var_self);   } +  ReturnTuple Call_defaultOrder(const S<TypeValue>& 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)));+    }+  }+   ReturnTuple Call_pop(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {     TRACE_FUNCTION("Vector.pop")     std::lock_guard<std::mutex> lock(mutex);@@ -147,8 +180,8 @@     });   return cache.GetOrCreate(params); }-S<TypeValue> CreateValue_Vector(S<Type_Vector> parent, const ParamTuple& params, VectorType values) {-  return S_get(new ExtValue_Vector(parent, params, values));+S<TypeValue> CreateValue_Vector(S<Type_Vector> parent, VectorType values) {+  return S_get(new ExtValue_Vector(parent, values)); }  #ifdef ZEOLITE_PUBLIC_NAMESPACE

@@ -21,10 +21,11 @@ // Params: // - #x: The value type contained. concrete Vector<#x> {+  refines Append<#x>+  refines DefaultOrder<#x>   refines Stack<#x>   refines ReadAt<#x>   refines WriteAt<#x>-  refines Append<#x>    // Create a copy from another random-access container.   @category copyFrom<#y> (ReadAt<#y>) -> (Vector<#y>)@@ -36,7 +37,7 @@   //   // Notes:   // - #y.default() should return a distinct value each time if #y is mutable.-   //  This means that modifying one element should not change others.+  //   This means that modifying one element should not change others.   @category createSize<#y>     #y defines Default   (Int) -> (Vector<#y>)

@@ -113,6 +113,25 @@   } } +unittest traverseVector {+  Int index <- 0+  Vector<Int> vector <- Vector:create<Int>()+  \ vector.push(2)+  \ vector.push(6)+  \ vector.push(3)+  \ vector.push(5)+  \ vector.push(4)+  \ vector.push(1)++  traverse (vector.defaultOrder() -> Int i) {+    \ Testing.checkEquals<?>(i,vector.readAt(index))+    index <- index+1+  }++  \ Testing.checkEquals<?>(index,6)+}++ testcase "distinct default values in pre-sized Vector" {   success }

@@ -25,7 +25,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif  // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ParamTuple& params, const ValueTuple& args);+S<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ValueTuple& args);  struct ExtCategory_RawFileReader : public Category_RawFileReader { };@@ -35,13 +35,13 @@    ReturnTuple Call_open(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {     TRACE_FUNCTION("RawFileReader.open")-    return ReturnTuple(CreateValue_RawFileReader(CreateType_RawFileReader(Params<0>::Type()), ParamTuple(), args));+    return ReturnTuple(CreateValue_RawFileReader(CreateType_RawFileReader(Params<0>::Type()), args));   } };  struct ExtValue_RawFileReader : public Value_RawFileReader {-  inline ExtValue_RawFileReader(S<Type_RawFileReader> p, const ParamTuple& params, const ValueTuple& args)-    : Value_RawFileReader(p, params),+  inline ExtValue_RawFileReader(S<Type_RawFileReader> p, const ValueTuple& args)+    : Value_RawFileReader(p),       filename(args.At(0)->AsString()),       file(new std::ifstream(filename, std::ios::in | std::ios::binary)) {} @@ -107,7 +107,7 @@   std::mutex mutex;   const std::string filename;   R<std::istream> file;-  CAPTURE_CREATION+  CAPTURE_CREATION("RawFileReader") };  Category_RawFileReader& CreateCategory_RawFileReader() {@@ -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 ParamTuple& params, const ValueTuple& args) {-  return S_get(new ExtValue_RawFileReader(parent, params, args));+S<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ValueTuple& args) {+  return S_get(new ExtValue_RawFileReader(parent, args)); }  #ifdef ZEOLITE_PUBLIC_NAMESPACE

@@ -25,7 +25,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif  // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ParamTuple& params, const ValueTuple& args);+S<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ValueTuple& args);  struct ExtCategory_RawFileWriter : public Category_RawFileWriter { };@@ -35,13 +35,13 @@    ReturnTuple Call_open(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {     TRACE_FUNCTION("RawFileWriter.open")-    return ReturnTuple(CreateValue_RawFileWriter(CreateType_RawFileWriter(Params<0>::Type()), ParamTuple(), args));+    return ReturnTuple(CreateValue_RawFileWriter(CreateType_RawFileWriter(Params<0>::Type()), args));   } };  struct ExtValue_RawFileWriter : public Value_RawFileWriter {-  inline ExtValue_RawFileWriter(S<Type_RawFileWriter> p, const ParamTuple& params, const ValueTuple& args)-    : Value_RawFileWriter(p, params),+  inline ExtValue_RawFileWriter(S<Type_RawFileWriter> p, const ValueTuple& args)+    : Value_RawFileWriter(p),       filename(args.At(0)->AsString()),       file(new std::ofstream(filename, std::ios::out | std::ios::binary | std::ios::trunc | std::ios::ate)) {} @@ -89,7 +89,7 @@   std::mutex mutex;   const std::string filename;   R<std::ostream> file;-  CAPTURE_CREATION+  CAPTURE_CREATION("RawFileWriter") };  Category_RawFileWriter& CreateCategory_RawFileWriter() {@@ -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 ParamTuple& params, const ValueTuple& args) {-  return S_get(new ExtValue_RawFileWriter(parent, params, args));+S<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ValueTuple& args) {+  return S_get(new ExtValue_RawFileWriter(parent, args)); }  #ifdef ZEOLITE_PUBLIC_NAMESPACE

@@ -198,10 +198,6 @@   } }; -struct ExtValue_Math : public Value_Math {-  inline ExtValue_Math(S<Type_Math> p, const ParamTuple& params, const ValueTuple& args) : Value_Math(p, params) {}-};- Category_Math& CreateCategory_Math() {   static auto& category = *new ExtCategory_Math();   return category;

@@ -30,7 +30,7 @@     #x defines Equals<#x>   (#x,#x) -> () -  // Check that the value is within a range. Crashes if they are not equal.+  // Check that the value is within a range. Crashes if it is not in the range.   //   // Args:   // - #x: Actual value.

@@ -4,6 +4,7 @@   "lib/util" ] private_deps: [+  "lib/container"   "lib/testing" ] extra_files: [@@ -16,8 +17,21 @@     categories: [ProcessThread]   }   category_source {+    source: "lib/thread/src/Extension_Realtime.cpp"+    categories: [Realtime]+  }+  category_source {     source: "lib/thread/src/Extension_SimpleMutex.cpp"     categories: [SimpleMutex]+  }+  category_source {+    source: "lib/thread/src/Extension_ThreadCondition.cpp"+    categories: [ThreadCondition]+  }+  category_source {+    source: "lib/thread/src/Extension_Enumerated.cpp"+    categories: [EnumeratedBarrier EnumeratedWait]+    requires: [Stack Vector]   } ] mode: incremental {

@@ -10,12 +10,10 @@ ## Configuring and Building  This library *is not* automatically built by `zeolite-setup`; you need to build-it manually. This is because there might be issues with linker dependencies-between different systems.+it manually. This is because there might be issues with thread-library+dependencies between different systems. -1. If you are running Linux, the config should work as-is. If you are running-   FreeBSD, you might need to remove or change `"-lpthread"` at the bottom of-   `.zeolite-module`.+1. If you are running Linux or FreeBSD, the config should work as-is.     To build the library: 

@@ -0,0 +1,23 @@+/* -----------------------------------------------------------------------------+Copyright 2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++$ModuleOnly$++concrete EnumeratedWait {+  refines BarrierWait+}

@@ -0,0 +1,46 @@+/* -----------------------------------------------------------------------------+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]++// Waits for a thread barrier.+@value interface BarrierWait {+  // Block until the barrier condition is satisfied.+  wait () -> (#self)+}++// A thread barrier validated using thread enumeration.+concrete EnumeratedBarrier {+  // Create a new barrier for a fixed number of threads.+  //+  // Args:+  // - Int: Non-negative number of threads.+  //+  // Returns:+  // - ReadAt<BarrierWait>: A list of the requested number of BarrierWait. These+  //   should be passed out to the respective threads.+  //+  // Notes:+  // - Each thread must use its own BarrierWait; otherwise, there will be an+  //   error-checking crash. For example, passing readAt(0) to all threads is+  //   not allowed.+  // - If a BarrierWait no longer has any references (and thus cannot be used),+  //   the barrier will be disabled. This will cause a crash if any thread is+  //   waiting for (or subsequently waits for) the barrier. This does not mean+  //   that you need to keep the ReadAt<BarrierWait> itself; one thread holding+  //   a reference to each individual BarrierWait is sufficient.+  @type new (Int) -> (ReadAt<BarrierWait>)+}

@@ -0,0 +1,178 @@+/* -----------------------------------------------------------------------------+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 "EnumeratedBarrier tests" {+  success+}++unittest correctCount {+  ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(13)+  \ Testing.checkEquals<?>(barriers.size(),13)+}++unittest waitForOneThread {+  ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(1)+  \ barriers.readAt(0).wait()+}++unittest zeroAllowed {+  ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(0)+  \ Testing.checkEquals<?>(barriers.size(),0)+}++unittest waitForMultipleThreads {+  Value value <- Value.create()+  Mutex mutex <- SimpleMutex.new()+  ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(3)++  Thread thread1 <- ProcessThread.from(WaitAndIncrement.create(2,value,mutex,barriers.readAt(1))).start()+  Thread thread2 <- ProcessThread.from(WaitAndIncrement.create(2,value,mutex,barriers.readAt(2))).start()++  \ barriers.readAt(0).wait()+  \ Testing.checkEquals<?>(value.get(),2)++  \ barriers.readAt(0).wait()+  \ Testing.checkEquals<?>(value.get(),4)++  \ thread1.join()+  \ thread2.join()+}++concrete WaitAndIncrement {+  refines Routine++  @type create (Int,Value,Mutex,BarrierWait) -> (WaitAndIncrement)+}++define WaitAndIncrement {+  @value Int count+  @value Value value+  @value Mutex mutex+  @value BarrierWait barrier++  create (count,value,mutex,barrier) {+    return WaitAndIncrement{ count, value, mutex, barrier }+  }++  run () {+    scoped {+      Int i <- 0+    } in while (i < count) {+      $Hidden[i,count]$+      scoped {+        MutexLock lock <- MutexLock.lock(mutex)+      } cleanup {+        \ lock.freeResource()+      } in {+        \ value.increment()+      }+      \ barrier.wait()+      // Gives the main thread time to read the value.+      \ Realtime.sleepSeconds(0.01)+    } update {+      i <- i+1+    }+  }+}+++testcase "EnumeratedBarrier crashes with negative count" {+  crash+  require "-4"+}++unittest test {+  ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(-4)+}+++testcase "wait() crashes when references are lost" {+  crash+  require "BarrierWait.*destroyed"+}++unittest test {+  scoped {+    ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(2)+  } in BarrierWait barrier <- barriers.readAt(0)+  \ barrier.wait()+}+++testcase "references lost during wait() causes crash" {+  crash+  require "BarrierWait.*waiting"+}++unittest test {+  scoped {+    ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(2)+  } in {+    Thread thread <- ProcessThread.from(WaitAndExit.create(barriers.readAt(0))).start()+    // Give the thread time to start.+    \ Realtime.sleepSeconds(0.1)+  }+}++concrete WaitAndExit {+  refines Routine++  @type create (BarrierWait) -> (WaitAndExit)+}++define WaitAndExit {+  @value BarrierWait barrier++  create (barrier) {+    return WaitAndExit{ barrier }+  }++  run () {+    \ barrier.wait()+  }+}+++testcase "wait() crashes when two threads use same BarrierWait" {+  crash+  require "BarrierWait.*in use"+}++unittest test {+  ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(2)+  Thread thread <- ProcessThread.from(WaitAndExit.create(barriers.readAt(0))).start()+  \ barriers.readAt(0).wait()+}++concrete WaitAndExit {+  refines Routine++  @type create (BarrierWait) -> (WaitAndExit)+}++define WaitAndExit {+  @value BarrierWait barrier++  create (barrier) {+    return WaitAndExit{ barrier }+  }++  run () {+    \ barrier.wait()+  }+}

@@ -0,0 +1,106 @@+/* -----------------------------------------------------------------------------+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]++// Blocks a thread until a condition is met.+//+// Notes:+// - Mutex logic is exposed so that it can be used to avoid race conditions with+//   the thread signalling continuation. (For example, if blocking behavior is+//   conditioned on the availability of input from another thread.)+@value interface ConditionWait {+  refines Mutex++  // Block the current thread.+  //+  // Notes:+  // - The current thread *must* lock() before wait() and unlock() after. The+  //   program could deadlock or crash otherwise.+  //+  // Example:+  //+  //   scoped {+  //     MutexLock lock <- MutexLock.lock(threadWait)+  //   } cleanup {+  //     \ lock.freeResource()+  //   } in \ threadWait.wait()+  //+  //   // continue processing here+  wait () -> (#self)++  // Block the current thread for at most the specified amount of time.+  //+  // Args:+  // - Float: Timeout in seconds.+  //+  // Returns:+  // - Bool: Set to false iff the timeout was reached.+  //+  // Notes:+  // - The current thread *must* lock() before timedWait() and unlock() after.+  //   The program could deadlock or crash otherwise.+  //+  // Example:+  //+  //   scoped {+  //     MutexLock lock <- MutexLock.lock(threadWait)+  //   } cleanup {+  //     \ lock.freeResource()+  //   } in Bool success <- threadWait.timedWait(10.0)+  //+  //   if (success) {+  //     // continue processing here+  //   } else {+  //     // error handling+  //   }+  timedWait (Float) -> (Bool)+}++// Resumes thread waiting for a condition.+//+// Example:+//+//   ConditionWait cond <- // created elsewhere+//+//   scoped {+//     MutexLock lock <- MutexLock.lock(cond)+//   } cleanup {+//     \ lock.freeResource()+//   } in {+//     // prepare state for threads, e.g., read data from disk+//   }+//+//   // signal threads to continue+//   \ cond.resumeAll()+@value interface ConditionResume {+  refines Mutex++  // Resume all of the threads waiting for the associated condition.+  resumeAll () -> (#self)++  // Resume one of the threads waiting for the associated condition.+  resumeOne () -> (#self)+}++// Provides a single resume mechanism for multiple waiting threads.+concrete ThreadCondition {+  refines ConditionWait+  refines ConditionResume++  // Create a new condition.+  @type new () -> (ThreadCondition)+}

@@ -0,0 +1,179 @@+/* -----------------------------------------------------------------------------+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 "ThreadCondition tests" {+  success+}++unittest resumeAll {+  Value value <- Value.create()+  ThreadCondition cond <- ThreadCondition.new()++  Thread thread1 <- ProcessThread.from(WaitAndUpdate.create(value,cond)).start()+  Thread thread2 <- ProcessThread.from(WaitAndUpdate.create(value,cond)).start()++  // Wait for both threads to increment Value once, to indicate readiness.+  while (true) {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+    } cleanup {+      \ lock.freeResource()+    } in if (value.get() >= 2) {+      break+    }+  }++  \ cond.resumeAll()+  \ thread1.join()+  \ thread2.join()++  \ Testing.checkEquals<?>(value.get(),4)+}++unittest resumeOne {+  Value value <- Value.create()+  ThreadCondition cond <- ThreadCondition.new()++  Thread thread1 <- ProcessThread.from(WaitAndUpdate.create(value,cond)).start()+  Thread thread2 <- ProcessThread.from(WaitAndUpdate.create(value,cond)).start()++  \ Realtime.sleepSeconds(0.01)++  // Wait for both threads to increment Value once, to indicate readiness.+  while (true) {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+    } cleanup {+      \ lock.freeResource()+    } in if (value.get() >= 2) {+      break+    }+  }++  \ cond.resumeOne()+  \ thread1.join()+  \ thread2.join()++  \ Testing.checkEquals<?>(value.get(),3)+}++unittest forceWaitTimeout {+  Value value <- Value.create()+  ThreadCondition cond <- ThreadCondition.new()++  Thread thread <- ProcessThread.from(WaitAndUpdate.create(value,cond)).start()++  \ Realtime.sleepSeconds(0.2)+  \ cond.resumeOne()+  \ thread.join()++  \ Testing.checkEquals<?>(value.get(),1)+}++unittest waitNoTimeout {+  ThreadCondition cond <- ThreadCondition.new()++  Thread thread <- ProcessThread.from(JustWait.create(cond)).start()++  \ Realtime.sleepSeconds(0.1)+  \ cond.resumeOne()+  \ thread.join()+  \ cond.lock().unlock()+}++concrete JustWait {+  refines Routine++  @type create (ConditionWait) -> (JustWait)+}++define JustWait {+  @value ConditionWait cond++  create (cond) {+    return JustWait{ cond }+  }++  run () {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+    } cleanup {+      \ lock.freeResource()+    } in \ cond.wait()+  }+}++concrete WaitAndUpdate {+  refines Routine++  @type create (Value,ConditionWait) -> (WaitAndUpdate)+}++define WaitAndUpdate {+  @value Value value+  @value ConditionWait cond++  create (value,cond) {+    return WaitAndUpdate{ value, cond }+  }++  run () {+    scoped {+      MutexLock lock <- MutexLock.lock(cond)+      // Increment once, to indicate readiness.+      \ value.increment()+    } cleanup {+      \ lock.freeResource()+    } in {+      // Mutex isn't unlocked until blocked here.+      if (cond.timedWait(0.1)) {+        \ value.increment()+      }+    }+  }+}+++testcase "wait() crashes if not locked first" {+  crash+  require "waiting for condition"+}++unittest test {+  \ ThreadCondition.new().wait()+}+++testcase "timedWait() crashes if not locked first" {+  crash+  require "waiting for condition"+}++unittest test {+  \ ThreadCondition.new().timedWait(0.1)+}+++testcase "timedWait() crashes with negative wait" {+  crash+  require "-0\.1"+}++unittest test {+  \ ThreadCondition.new().lock().timedWait(-0.1)+}

@@ -101,38 +101,3 @@     }   } }--concrete Value {-  @type create () -> (Value)--  @value get () -> (Int)-  @value increment () -> ()--  @value setInUse (Bool) -> ()-  @value getInUse () -> (Bool)-}--define Value {-  @value Int value-  @value Bool inUse--  create () {-    return Value{ 0, false }-  }--  get () {-    return value-  }--  increment () {-    value <- value+1-  }--  setInUse (i) {-    inUse <- i-  }--  getInUse () {-    return inUse-  }-}

@@ -0,0 +1,194 @@+/* -----------------------------------------------------------------------------+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 <atomic>++#include <pthread.h>+#include <string.h>++#include "category-source.hpp"+#include "Streamlined_EnumeratedWait.hpp"+#include "Streamlined_EnumeratedBarrier.hpp"+#include "Category_BarrierWait.hpp"+#include "Category_EnumeratedBarrier.hpp"+#include "Category_Int.hpp"+#include "Category_Stack.hpp"+#include "Category_Vector.hpp"++namespace {++class Barrier {+ public:+  Barrier(int count) : index_usage(new std::atomic_int[count]) {+    alive.store(true);+    wait_count.store(0);+    for (int i = 0; i < count; ++i) {+      index_usage[i].store(0);+    }+    int error = pthread_barrier_init(&barrier, NULL, count);+    if (error != 0) {+      FAIL() << "Error creating barrier: " << strerror(error) << " (error " << error << ")";+    }+  }++  void Wait(int index) {+    TRACE_CREATION+    Enter(index);+    int error = pthread_barrier_wait(&barrier);+    if (error != 0 && error != PTHREAD_BARRIER_SERIAL_THREAD) {+      FAIL() << "Error waiting for barrier: " << strerror(error) << " (error " << error << ")";+    }+    Exit(index);+  }++  void Kill(int index) {+    TRACE_CREATION+    if (alive.exchange(false) && wait_count.load() > 0) {+      FAIL() << "BarrierWait at index " << index << " destroyed while one or more threads were waiting";+    }+  }++  ~Barrier() {+    TRACE_CREATION+    int error = pthread_barrier_destroy(&barrier);+    if (error != 0) {+      FAIL() << "Error cleaning up barrier: " << strerror(error) << " (error " << error << ")";+    }+  }++private:+  void Enter(int index) {+    ++wait_count;+    if (!alive.load()) {+      --wait_count;+      FAIL() << "One or more BarrierWait have been destroyed";+    }+    if (++index_usage[index] > 1) {+      Exit(index);+      FAIL() << "BarrierWait at index " << index << " is already in use";+    }+  }++  void Exit(int index) {+    --wait_count;+    --index_usage[index];+  }++  std::atomic_bool alive;+  std::atomic_int wait_count;+  const R<std::atomic_int[]> index_usage;+  pthread_barrier_t barrier;+  CAPTURE_CREATION("EnumeratedBarrier")+};++}  // namespace++#ifdef ZEOLITE_PRIVATE_NAMESPACE+namespace ZEOLITE_PRIVATE_NAMESPACE {+#endif  // ZEOLITE_PRIVATE_NAMESPACE++S<TypeValue> CreateValue_EnumeratedWait(+  S<Type_EnumeratedWait> parent, S<Barrier> b, int i);++struct ExtCategory_EnumeratedWait : public Category_EnumeratedWait {+};++struct ExtType_EnumeratedWait : public Type_EnumeratedWait {+  inline ExtType_EnumeratedWait(Category_EnumeratedWait& p, Params<0>::Type params) : Type_EnumeratedWait(p, params) {}+};++struct ExtValue_EnumeratedWait : public Value_EnumeratedWait {+  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 {+    TRACE_FUNCTION("EnumeratedWait.wait")+    barrier->Wait(index);+    return ReturnTuple(Var_self);+  }++  ~ExtValue_EnumeratedWait() {+    barrier->Kill(index);+  }++  const S<Barrier> barrier;+  int index;+};++Category_EnumeratedWait& CreateCategory_EnumeratedWait() {+  static auto& category = *new ExtCategory_EnumeratedWait();+  return category;+}+S<Type_EnumeratedWait> CreateType_EnumeratedWait(Params<0>::Type params) {+  static const auto cached = S_get(new ExtType_EnumeratedWait(CreateCategory_EnumeratedWait(), Params<0>::Type()));+  return cached;+}+S<TypeValue> CreateValue_EnumeratedWait(+  S<Type_EnumeratedWait> parent, S<Barrier> b, int i) {+  return S_get(new ExtValue_EnumeratedWait(parent, b, i));+}++#ifdef ZEOLITE_PRIVATE_NAMESPACE+}  // namespace ZEOLITE_PRIVATE_NAMESPACE+using namespace ZEOLITE_PRIVATE_NAMESPACE;+#endif  // ZEOLITE_PRIVATE_NAMESPACE+++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif  // ZEOLITE_PUBLIC_NAMESPACE++struct ExtCategory_EnumeratedBarrier : public Category_EnumeratedBarrier {+};++struct ExtType_EnumeratedBarrier : public Type_EnumeratedBarrier {+  inline ExtType_EnumeratedBarrier(Category_EnumeratedBarrier& p, Params<0>::Type params) : Type_EnumeratedBarrier(p, params) {}++  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();+    if (Var_arg1 < 0) {+      FAIL() << "Invalid barrier thread count " << Var_arg1;+    }+    S<TypeValue> vector = GetCategory_Vector().Call(+      Function_Vector_create,+      ParamTuple(GetType_EnumeratedWait(Params<0>::Type())),+      ArgTuple()).Only();+    S<Barrier> barrier(Var_arg1? new Barrier(Var_arg1) : nullptr);+    for (int i = 0; i < Var_arg1; ++i) {+      S<TypeValue> wait = CreateValue_EnumeratedWait(+        CreateType_EnumeratedWait(Params<0>::Type()), barrier, i);+      TypeValue::Call(vector, Function_Stack_push, ParamTuple(), ArgTuple(wait));+    }+    return ReturnTuple(vector);+  }+};++Category_EnumeratedBarrier& CreateCategory_EnumeratedBarrier() {+  static auto& category = *new ExtCategory_EnumeratedBarrier();+  return category;+}+S<Type_EnumeratedBarrier> CreateType_EnumeratedBarrier(Params<0>::Type params) {+  static const auto cached = S_get(new ExtType_EnumeratedBarrier(CreateCategory_EnumeratedBarrier(), Params<0>::Type()));+  return cached;+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+}  // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif  // ZEOLITE_PUBLIC_NAMESPACE

@@ -28,7 +28,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif  // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_MutexLock(S<Type_MutexLock> parent, const ParamTuple& params, const ValueTuple& args);+S<TypeValue> CreateValue_MutexLock(S<Type_MutexLock> parent, const ValueTuple& args);  struct ExtCategory_MutexLock : public Category_MutexLock { };@@ -38,18 +38,18 @@    ReturnTuple Call_lock(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {     TRACE_FUNCTION("MutexLock.lock")-    return ReturnTuple(CreateValue_MutexLock(CreateType_MutexLock(Params<0>::Type()), ParamTuple(), args));+    return ReturnTuple(CreateValue_MutexLock(CreateType_MutexLock(Params<0>::Type()), args));   } };  struct ExtValue_MutexLock : public Value_MutexLock {-  inline ExtValue_MutexLock(S<Type_MutexLock> p, const ParamTuple& params, const ValueTuple& args)-    : Value_MutexLock(p, params), mutex(args.Only()) {+  inline ExtValue_MutexLock(S<Type_MutexLock> p, const ValueTuple& args)+    : Value_MutexLock(p), mutex(args.Only()) {     TypeValue::Call(mutex, Function_Mutex_lock, ParamTuple(), ArgTuple());   }    ReturnTuple Call_freeResource(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {-    TRACE_FUNCTION("PersistentResource.freeResource")+    TRACE_FUNCTION("MutexLock.freeResource")     TRACE_CREATION     if (!mutex) {       FAIL() << "MutexLock freed multiple times";@@ -70,7 +70,7 @@   }    S<TypeValue> mutex;-  CAPTURE_CREATION+  CAPTURE_CREATION("MutexLock") };  Category_MutexLock& CreateCategory_MutexLock() {@@ -81,8 +81,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 ParamTuple& params, const ValueTuple& args) {-  return S_get(new ExtValue_MutexLock(parent, params, args));+S<TypeValue> CreateValue_MutexLock(S<Type_MutexLock> parent, const ValueTuple& args) {+  return S_get(new ExtValue_MutexLock(parent, args)); }  #ifdef ZEOLITE_PUBLIC_NAMESPACE

@@ -31,7 +31,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif  // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_ProcessThread(S<Type_ProcessThread> parent, const ParamTuple& params, const ValueTuple& args);+S<TypeValue> CreateValue_ProcessThread(S<Type_ProcessThread> parent, const ValueTuple& args);  struct ExtCategory_ProcessThread : public Category_ProcessThread { };@@ -41,16 +41,16 @@    ReturnTuple Call_from(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {     TRACE_FUNCTION("ProcessThread.from")-    return ReturnTuple(CreateValue_ProcessThread(CreateType_ProcessThread(Params<0>::Type()), params, args));+    return ReturnTuple(CreateValue_ProcessThread(CreateType_ProcessThread(Params<0>::Type()), args));   } };  struct ExtValue_ProcessThread : public Value_ProcessThread {-  inline ExtValue_ProcessThread(S<Type_ProcessThread> p, const ParamTuple& params, const ValueTuple& args)-    : Value_ProcessThread(p, params), routine(args.Only()) {}+  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 {-    TRACE_FUNCTION("Thread.detach")+    TRACE_FUNCTION("ProcessThread.detach")     S<std::thread> temp = thread;     thread = nullptr;     if (!isJoinable(temp.get())) {@@ -62,12 +62,12 @@   }    ReturnTuple Call_isRunning(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {-    TRACE_FUNCTION("Thread.isRunning")+    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 {-    TRACE_FUNCTION("Thread.join")+    TRACE_FUNCTION("ProcessThread.join")     S<std::thread> temp = thread;     thread = nullptr;     if (!isJoinable(temp.get())) {@@ -79,7 +79,7 @@   }    ReturnTuple Call_start(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {-    TRACE_FUNCTION("Process.start")+    TRACE_FUNCTION("ProcessThread.start")     if (isJoinable(thread.get())) {       FAIL() << "thread is already running";     } else {@@ -87,10 +87,10 @@       // it's still running. This allows the caller to hold a weak reference to       // the thread.       thread.reset(new std::thread(-        [this,Var_self] {+        capture_thread::ThreadCrosser::WrapCall([this,Var_self] {           TRACE_CREATION           TypeValue::Call(routine, Function_Routine_run, ParamTuple(), ArgTuple());-        }));+        })));     }     return ReturnTuple(Var_self);   }@@ -109,7 +109,7 @@    const S<TypeValue> routine;   S<std::thread> thread;-  CAPTURE_CREATION+  CAPTURE_CREATION("ProcessThread") };  Category_ProcessThread& CreateCategory_ProcessThread() {@@ -120,8 +120,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 ParamTuple& params, const ValueTuple& args) {-  return S_get(new ExtValue_ProcessThread(parent, params, args));+S<TypeValue> CreateValue_ProcessThread(S<Type_ProcessThread> parent, const ValueTuple& args) {+  return S_get(new ExtValue_ProcessThread(parent, args)); }  #ifdef ZEOLITE_PUBLIC_NAMESPACE

@@ -0,0 +1,69 @@+/* -----------------------------------------------------------------------------+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 <errno.h>+#include <math.h>+#include <string.h>+#include <time.h>++#include "category-source.hpp"+#include "Streamlined_Realtime.hpp"+#include "Category_Float.hpp"+#include "Category_Realtime.hpp"++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif  // ZEOLITE_PUBLIC_NAMESPACE++struct ExtCategory_Realtime : public Category_Realtime {+};++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();+    if (Var_arg1 < 0) {+      FAIL() << "Bad wait time " << Var_arg1;+    }+    struct timespec timeout{ (int) trunc(Var_arg1), (int) (1000000000.0 * (Var_arg1-trunc(Var_arg1))) };+    struct timespec remainder;+    while (nanosleep(&timeout, &remainder) != 0) {+      if (errno == EINTR) {+        timeout = remainder;+      } else {+        FAIL() << "Error sleeping: " << strerror(errno) << " (error " << errno << ")";+      }+    }+    return ReturnTuple();+  }+};++Category_Realtime& CreateCategory_Realtime() {+  static auto& category = *new ExtCategory_Realtime();+  return category;+}+S<Type_Realtime> CreateType_Realtime(Params<0>::Type params) {+  static const auto cached = S_get(new ExtType_Realtime(CreateCategory_Realtime(), Params<0>::Type()));+  return cached;+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+}  // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif  // ZEOLITE_PUBLIC_NAMESPACE

@@ -42,16 +42,16 @@ };  struct ExtValue_SimpleMutex : public Value_SimpleMutex {-  inline ExtValue_SimpleMutex(S<Type_SimpleMutex> p, const ParamTuple& params) : Value_SimpleMutex(p, params) {}+  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 {-    TRACE_FUNCTION("Mutex.lock")+    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 {-    TRACE_FUNCTION("Mutex.unlock")+    TRACE_FUNCTION("SimpleMutex.unlock")     mutex.unlock();     return ReturnTuple(Var_self);   }@@ -68,7 +68,7 @@   return cached; } S<TypeValue> CreateValue_SimpleMutex(S<Type_SimpleMutex> parent) {-  return S_get(new ExtValue_SimpleMutex(parent, ParamTuple()));+  return S_get(new ExtValue_SimpleMutex(parent)); }  #ifdef ZEOLITE_PUBLIC_NAMESPACE

@@ -0,0 +1,164 @@+/* -----------------------------------------------------------------------------+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 <math.h>+#include <pthread.h>+#include <string.h>+#include <time.h>+#include <sys/time.h>++#include "category-source.hpp"+#include "Streamlined_ThreadCondition.hpp"+#include "Category_ThreadCondition.hpp"+#include "Category_ConditionResume.hpp"+#include "Category_ConditionWait.hpp"++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif  // ZEOLITE_PUBLIC_NAMESPACE++S<TypeValue> CreateValue_ThreadCondition(S<Type_ThreadCondition> parent);++struct ExtCategory_ThreadCondition : public Category_ThreadCondition {+};++struct ExtType_ThreadCondition : public Type_ThreadCondition {+  inline ExtType_ThreadCondition(Category_ThreadCondition& p, Params<0>::Type params) : Type_ThreadCondition(p, params) {}++  ReturnTuple Call_new(const S<TypeInstance>& Param_self, const ParamTuple& params, const ValueTuple& args) final {+    TRACE_FUNCTION("ThreadCondition.new")+    return ReturnTuple(CreateValue_ThreadCondition(CreateType_ThreadCondition(Params<0>::Type())));+  }+};++struct ExtValue_ThreadCondition : public Value_ThreadCondition {+  inline ExtValue_ThreadCondition(S<Type_ThreadCondition> p) : Value_ThreadCondition(p) {+    pthread_mutexattr_t mutex_attr;+    pthread_mutexattr_init(&mutex_attr);+    // NOTE: Error checking is required to catch attempted waits without first+    // locking the mutex.+    pthread_mutexattr_settype(&mutex_attr, PTHREAD_MUTEX_ERRORCHECK);+    pthread_mutex_init(&mutex, &mutex_attr);+  }++  ReturnTuple Call_lock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {+    TRACE_FUNCTION("ThreadCondition.lock")+    int error = 0;+    if ((error = pthread_mutex_lock(&mutex)) != 0) {+      FailError("Error locking mutex", error);+    }+    return ReturnTuple(Var_self);+  }++  ReturnTuple Call_resumeAll(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {+    TRACE_FUNCTION("ThreadCondition.resumeAll")+    int error = 0;+    if ((error = pthread_cond_broadcast(&cond)) != 0) {+      FailError("Error resuming threads", error);+    }+    return ReturnTuple(Var_self);+  }++  ReturnTuple Call_resumeOne(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {+    TRACE_FUNCTION("ThreadCondition.resumeOne")+    int error = 0;+    if ((error = pthread_cond_signal(&cond)) != 0) {+      FailError("Error resuming thread", error);+    }+    return ReturnTuple(Var_self);+  }++  ReturnTuple Call_timedWait(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {+    TRACE_FUNCTION("ThreadCondition.timedWait")+    int error = 0;+    const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+    if (Var_arg1 < 0) {+      FAIL() << "Bad wait time " << Var_arg1;+    }+    struct timeval now;+    if (gettimeofday(&now, NULL) != 0) {+      FailError("Error getting current time", errno);+    }+    const PrimFloat abs_time = Var_arg1 + (PrimFloat) now.tv_sec + ((PrimFloat) now.tv_usec / 1000000.0);+    struct timespec timeout{ (int) trunc(abs_time), (int) (1000000000.0 * (abs_time-trunc(abs_time))) };+    error = pthread_cond_timedwait(&cond, &mutex, &timeout);+    if (error == ETIMEDOUT) {+      return ReturnTuple(Box_Bool(false));+    }+    if (error != 0) {+      FailError("Error waiting for condition", error);+    }+    return ReturnTuple(Box_Bool(true));+  }++  ReturnTuple Call_unlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {+    TRACE_FUNCTION("ThreadCondition.unlock")+    int error = 0;+    if ((error = pthread_mutex_unlock(&mutex)) != 0) {+      FailError("Error unlocking mutex", error);+    }+    return ReturnTuple(Var_self);+  }++  ReturnTuple Call_wait(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) final {+    TRACE_FUNCTION("ThreadCondition.wait")+    int error = 0;+    if ((error = pthread_cond_wait(&cond, &mutex)) != 0) {+      FailError("Error waiting for condition", error);+    }+    return ReturnTuple(Var_self);+  }++  void FailError(const std::string& context, int error) const {+    TRACE_CREATION+    FAIL() << context << ": " << strerror(error) << " (error " << error << ")";+  }++  ~ExtValue_ThreadCondition() {+    int error = 0;+    // Nothing should be waiting on the condition, because then there would+    // still be a reference to this object.+    if ((error = pthread_cond_destroy(&cond)) != 0) {+      FailError("Error cleaning up condition", error);+    }+    if ((error = pthread_mutex_destroy(&mutex)) != 0) {+      FailError("Error cleaning up mutex", error);+    }+  }++  pthread_cond_t  cond  = PTHREAD_COND_INITIALIZER;+  pthread_mutex_t mutex;+  CAPTURE_CREATION("ThreadCondition")+};++Category_ThreadCondition& CreateCategory_ThreadCondition() {+  static auto& category = *new ExtCategory_ThreadCondition();+  return category;+}+S<Type_ThreadCondition> CreateType_ThreadCondition(Params<0>::Type params) {+  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));+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+}  // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif  // ZEOLITE_PUBLIC_NAMESPACE

@@ -24,3 +24,19 @@    @type create () -> (NoOpRoutine) }++concrete InfiniteRoutine {+  refines Routine++  @type create () -> (InfiniteRoutine)+}++concrete Value {+  @type create () -> (Value)++  @value get () -> (Int)+  @value increment () -> ()++  @value setInUse (Bool) -> ()+  @value getInUse () -> (Bool)+}

@@ -25,3 +25,38 @@    run () {} }++define InfiniteRoutine {+  create () {+    return InfiniteRoutine{ }+  }++  run () {+    while (true) {}+  }+}++define Value {+  @value Int value+  @value Bool inUse++  create () {+    return Value{ 0, false }+  }++  get () {+    return value+  }++  increment () {+    value <- value+1+  }++  setInUse (i) {+    inUse <- i+  }++  getInUse () {+    return inUse+  }+}

@@ -21,7 +21,7 @@ }  unittest test {-  Counter counter <- Counter.create(10000)+  CountLoop counter <- CountLoop.create(10000)   \ Testing.checkEquals<?>(counter.get(),0)   \ counter.start()   \ Testing.checkEquals<?>(counter.get(),10000)@@ -29,14 +29,14 @@   \ Testing.checkEquals<?>(counter.get(),20000) } -concrete Counter {+concrete CountLoop {   refines Process -  @type create (Int) -> (Counter)+  @type create (Int) -> (CountLoop)   @value get () -> (Int) } -define Counter {+define CountLoop {   refines Routine    @value Int current@@ -44,7 +44,7 @@   @value weak Thread thread    create (c) {-    return Counter{ 0, c, empty }+    return CountLoop{ 0, c, empty }   }    start ()  {@@ -78,6 +78,32 @@ }  +testcase "Argv available in Thread" {+  success+  args "arg1"+}++unittest test {+  \ ProcessThread.from(CheckArgv.create()).start().join()+}++concrete CheckArgv {+  refines Routine++  @type create () -> (CheckArgv)+}++define CheckArgv {+  create () {+    return CheckArgv{ }+  }++  run () {+    \ Testing.checkEquals<?>(Argv.global().readAt(1),"arg1")+  }+}++ testcase "join() crashes if Thread not started yet" {   crash   require "thread.*started"@@ -88,13 +114,22 @@ }  +testcase "join() once" {+  success+}++unittest test {+  \ ProcessThread.from(NoOpRoutine.create()).start().join()+}++ testcase "join() twice crashes" {   crash   require "thread.*started" }  unittest test {-  \ ProcessThread.from(NoOpRoutine.create()).join().join()+  \ ProcessThread.from(NoOpRoutine.create()).start().join().join() }  @@ -104,17 +139,26 @@ }  unittest test {-  \ ProcessThread.from(NoOpRoutine.create()).detach()+  \ ProcessThread.from(InfiniteRoutine.create()).detach() }  +testcase "detach() once" {+  success+}++unittest test {+  \ ProcessThread.from(InfiniteRoutine.create()).start().detach()+}++ testcase "detach() twice crashes" {   crash   require "thread.*started" }  unittest test {-  \ ProcessThread.from(NoOpRoutine.create()).detach().detach()+  \ ProcessThread.from(InfiniteRoutine.create()).start().detach().detach() }  

@@ -0,0 +1,23 @@+/* -----------------------------------------------------------------------------+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]++// Functions for realtime computation.+concrete Realtime {+  // Sleep for the given number of seconds.+  @type sleepSeconds (Float) -> ()+}

@@ -0,0 +1,35 @@+/* -----------------------------------------------------------------------------+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 "negative sleepSeconds() crashes" {+  crash+  require "-0\.1"+}++unittest test {+  \ Realtime.sleepSeconds(-0.1)+}+++testcase "zero sleepSeconds() is allowed" {+  success+}++unittest test {+  \ Realtime.sleepSeconds(0.0)+}

@@ -0,0 +1,33 @@+/* -----------------------------------------------------------------------------+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]++// Creates Order<Int> counters, for use with traverse.+concrete Counter {+  // Create a sequence of indices for a Container of the given size.+  @type zeroIndexed (Int) -> (optional Order<Int>)+  // Create an unbounded Int sequence.+  @type unlimited   ()    -> (optional Order<Int>)+}++// Creates an Order<#x> that repeats a single value, for use with traverse.+concrete Repeat<#x> {+  // Repeat the value the specified number of times.+  @category times<#y>     (#y,Int) -> (optional Order<#y>)+  // Repeat the value an unlimited number of times.+  @category unlimited<#y> (#y)     -> (optional Order<#y>)+}

@@ -0,0 +1,69 @@+/* -----------------------------------------------------------------------------+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 "counter tests" {+  success+}++unittest zeroIndexed {+  Int index <- 0++  traverse (Counter.zeroIndexed(10) -> Int i) {+    \ Testing.checkEquals<?>(i,index)+    index <- index+1+  }++  \ Testing.checkEquals<?>(index,10)+}++unittest unlimitedCount {+  Int index <- 0++  traverse (Counter.unlimited() -> Int i) {+    \ Testing.checkEquals<?>(i,index)+    if ((index <- index+1) >= 10) {+      break+    }+  }++  \ Testing.checkEquals<?>(index,10)+}++unittest times {+  Int index <- 0++  traverse ("message" `Repeat:times<?>` 10 -> String m) {+    \ Testing.checkEquals<?>(m,"message")+    index <- index+1+  }++  \ Testing.checkEquals<?>(index,10)+}++unittest unlimitedValue {+  Int index <- 0++  traverse (Repeat:unlimited<?>("message") -> String m) {+    \ Testing.checkEquals<?>(m,"message")+    if ((index <- index+1) >= 10) {+      break+    }+  }++  \ Testing.checkEquals<?>(index,10)+}

@@ -0,0 +1,86 @@+/* -----------------------------------------------------------------------------+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 Counter {+  $ReadOnly[max]$++  refines Order<Int>++  @value Int current+  @value Int max++  zeroIndexed (max) {+    if (max <= 0) {+      return empty+    } else {+      return Counter{ 0, max }+    }+  }++  unlimited () {+    return Counter{ 0, -1 }+  }++  next () {+    if (max < 0 || current+1 < max) {+      current <- current+1+      return self+    } else {+      return empty+    }+  }++  get () {+    return current+  }+}++define Repeat {+  $ReadOnly[max,value]$++  refines Order<#x>++  @value #x value+  @value Int current+  @value Int max++  times (value,max) {+    if (max <= 0) {+      return empty+    } else {+      return Repeat<#y>{ value, 0, max }+    }+  }++  unlimited (value) {+    return Repeat<#y>{ value, 0, -1 }+  }++  next () {+    if (max < 0 || current+1 < max) {+      current <- current+1+      return self+    } else {+      return empty+    }+  }++  get () {+    return value+  }+}

@@ -60,7 +60,6 @@   // Return the global set of arguments for the program.   //   // Notes:-  // - This is empty outside of the main program thread.   // - When used in unit tests, arg 0 is "testcase" and the remaining args are   //   set from args in the testcase. (See extra.0rt.)   @type global () -> ([ReadAt<String>&SubSequence])

@@ -22,7 +22,7 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif  // ZEOLITE_PUBLIC_NAMESPACE -S<TypeValue> CreateValue_Argv(S<Type_Argv> parent, const ParamTuple& params, int st, int sz);+S<TypeValue> CreateValue_Argv(S<Type_Argv> parent, int st, int sz);  namespace { extern const S<TypeValue>& Var_global;@@ -41,8 +41,8 @@ };  struct ExtValue_Argv : public Value_Argv {-  inline ExtValue_Argv(S<Type_Argv> p, const ParamTuple& params, int st, int sz)-    : Value_Argv(p, params), start(st), size(sz) {}+  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 {     TRACE_FUNCTION("Argv.readAt")@@ -65,7 +65,7 @@     if (Var_arg2 < 0 || Var_arg1 + Var_arg2 > GetSize()) {       FAIL() << "size " << Var_arg2 << " is invalid";     }-    return ReturnTuple(S<TypeValue>(new ExtValue_Argv(parent, ParamTuple(), start + Var_arg1, Var_arg2)));+    return ReturnTuple(S<TypeValue>(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()), ParamTuple(), 0, -1));+const S<TypeValue>& Var_global = *new S<TypeValue>(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, const ParamTuple& params, int st, int sz) {-  return S_get(new ExtValue_Argv(parent, params, st, sz));+S<TypeValue> CreateValue_Argv(S<Type_Argv> parent, int st, int sz) {+  return S_get(new ExtValue_Argv(parent, st, sz)); }  #ifdef ZEOLITE_PUBLIC_NAMESPACE

@@ -42,7 +42,7 @@ };  struct ExtValue_SimpleInput : public Value_SimpleInput {-  inline ExtValue_SimpleInput(S<Type_SimpleInput> p, const ParamTuple& params, const ValueTuple& args) : Value_SimpleInput(p, params) {}+  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 {     TRACE_FUNCTION("SimpleInput.pastEnd")@@ -72,7 +72,7 @@ };  namespace {-const S<TypeValue>& Var_stdin = *new S<TypeValue>(new ExtValue_SimpleInput(CreateType_SimpleInput(Params<0>::Type()), ParamTuple(), ArgTuple()));+const S<TypeValue>& Var_stdin = *new S<TypeValue>(new ExtValue_SimpleInput(CreateType_SimpleInput(Params<0>::Type()), ArgTuple())); }  // namespace  Category_SimpleInput& CreateCategory_SimpleInput() {

@@ -63,8 +63,8 @@ }  // namespace  struct ExtValue_SimpleOutput : public Value_SimpleOutput {-  inline ExtValue_SimpleOutput(S<Type_SimpleOutput> p, const ParamTuple& params, S<Writer> w)-    : Value_SimpleOutput(p, params), writer(w) {}+  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 {     TRACE_FUNCTION("SimpleOutput.flush")@@ -115,9 +115,9 @@   std::ostringstream output; }; -const S<TypeValue>& Var_stdout = *new S<TypeValue>(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new StreamWriter(std::cout))));-const S<TypeValue>& Var_stderr = *new S<TypeValue>(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new StreamWriter(std::cerr))));-const S<TypeValue>& Var_error  = *new S<TypeValue>(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new ErrorWriter())));+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())));  }  // namespace 

@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -33,6 +33,7 @@   isCompileFast,   isCompileIncremental,   isCompileRecompile,+  isCompileUnspecified,   isCreateTemplates,   isExecuteTests,   maybeDisableHelp,@@ -110,7 +111,8 @@     cfSource :: FilePath   } |   ExecuteTests {-    etInclude :: [FilePath]+    etInclude :: [FilePath],+    etCallLog :: Maybe FilePath   } |   CompileIncremental {     ciLinkFlags :: [String]@@ -139,12 +141,16 @@ isCompileRecompile _                         = False  isExecuteTests :: CompileMode -> Bool-isExecuteTests (ExecuteTests _) = True-isExecuteTests _                = False+isExecuteTests (ExecuteTests _ _) = True+isExecuteTests _                  = False  isCreateTemplates :: CompileMode -> Bool isCreateTemplates CreateTemplates = True isCreateTemplates _               = False++isCompileUnspecified :: CompileMode -> Bool+isCompileUnspecified CompileUnspecified = True+isCompileUnspecified _                  = False  maybeDisableHelp :: HelpMode -> HelpMode maybeDisableHelp HelpUnspecified = HelpNotNeeded

@@ -281,8 +281,7 @@   mapCompilerM_ writeTemplate ts where     generate testing tm n = do       (_,t) <- getConcreteCategory tm ([],n)-      let ctx = FileContext testing tm Set.empty Map.empty-      generateStreamlinedTemplate ctx t+      generateStreamlinedTemplate testing tm t     writeTemplate (CxxOutput _ n _ _ _ content) = do       let n' = p </> d </> n       exists <- errorFromIO $ doesFileExist n'@@ -292,15 +291,16 @@            errorFromIO $ hPutStrLn stderr $ "Writing file " ++ n            errorFromIO $ writeFile n' $ concat $ map (++ "\n") content -runModuleTests :: (PathIOHandler r, CompilerBackend b) => r -> b -> FilePath ->-  [FilePath] -> LoadedTests -> TrackedErrorsIO [((Int,Int),TrackedErrors ())]-runModuleTests resolver backend base tp (LoadedTests p d m em deps1 deps2) = do+runModuleTests :: (PathIOHandler r, CompilerBackend b) =>+  r -> b -> FilePath -> FilePath -> [FilePath] -> LoadedTests ->+  TrackedErrorsIO [((Int,Int),TrackedErrors ())]+runModuleTests resolver backend cl base tp (LoadedTests p d m em deps1 deps2) = do   let paths = base:(cmPublicSubdirs m ++ cmPrivateSubdirs m ++ getIncludePathsForDeps deps1)   mapCompilerM_ showSkipped $ filter (not . isTestAllowed) $ cmTestFiles m   ts' <- zipWithContents resolver p $ map (d </>) $ filter isTestAllowed $ cmTestFiles m   path <- errorFromIO $ canonicalizePath (p </> d)   cm <- fmap (createLanguageModule [] [] em) $ loadModuleGlobals resolver path (NoNamespace,NoNamespace) [] (Just m) deps1 []-  mapCompilerM (runSingleTest backend cm path paths (m:deps2)) ts' where+  mapCompilerM (runSingleTest backend cl cm path paths (m:deps2)) ts' where     allowTests = Set.fromList tp     isTestAllowed t = if null allowTests then True else t `Set.member` allowTests     showSkipped f = compilerWarningM $ "Skipping tests in " ++ f ++ " due to explicit test filter."

@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -35,12 +35,12 @@ optionHelpText :: [String] optionHelpText = [     "",-    "zeolite [options...] -m [category(.function)] -o [binary] [path]",-    "zeolite [options...] --fast [category(.function)] [.0rx source]",     "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...]",+    "zeolite [options...] -t [paths...] (--log-traces [filename])",     "",     "zeolite [options...] --templates [paths...]",     "zeolite --get-path",@@ -48,8 +48,8 @@     "zeolite --version",     "",     "Normal Modes:",-    "  -c: Only compile the individual files. (default)",-    "  -m [category(.function)]: Create a binary that executes the function.",+    "  -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.",@@ -67,6 +67,7 @@     "  -I [path]: A single source path 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.",+    "  --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.",@@ -117,7 +118,7 @@    parseSingle (CompileOptions h is is2 ds es ep p m f) ((n,"-t"):os)     | m /= CompileUnspecified = argError n "-t" "Compiler mode already set."-    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep p (ExecuteTests []) f)+    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep p (ExecuteTests [] Nothing) f)    parseSingle (CompileOptions h is is2 ds es ep p m f) ((n,"--templates"):os)     | m /= CompileUnspecified = argError n "-t" "Compiler mode already set."@@ -152,6 +153,13 @@           check _          = argError n2 c $ "Invalid entry point."       update _ = argError n "--fast" "Requires a category name and a .0rx file." +  parseSingle (CompileOptions h is is2 ds es ep p (ExecuteTests tp cl) f) ((n,"--log-traces"):os) = update os where+    update ((_,cl2):os2)+      | cl /= Nothing = argError n "--log-traces" "Trace-log filename already set."+      | otherwise = return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep p (ExecuteTests tp (Just cl2)) f)+    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)     | not $ null o = argError n "-o" "Output name already set."     | otherwise = update os where@@ -159,7 +167,7 @@         checkPathName n2 o2 "-o"         return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep p (CompileBinary t fn o2 lf) f)       update _ = argError n "-o" "Requires an output name."-  parseSingle _ ((n,"-o"):_) = argError n "-o" "Set mode to binary (-m) first"+  parseSingle _ ((n,"-o"):_) = argError n "-o" "Set mode to binary (-m) first."    parseSingle (CompileOptions h is is2 ds es ep p m f) ((n,"-i"):os) = update os where     update ((n2,d):os2)@@ -198,8 +206,8 @@         when (not $ isExecuteTests m) $           argError n d "Test mode (-t) must be enabled before listing any .0rt test files."         checkPathName n d ""-        let (ExecuteTests tp) = m-        return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep p (ExecuteTests $ tp ++ [d]) f)+        let (ExecuteTests tp cl) = m+        return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep p (ExecuteTests (tp ++ [d]) cl) f)       | otherwise = do         checkPathName n d ""         return (os,CompileOptions (maybeDisableHelp h) is is2 (ds ++ [d]) es ep p m f)@@ -207,6 +215,9 @@ validateCompileOptions :: CollectErrorsM m => CompileOptions -> m CompileOptions validateCompileOptions co@(CompileOptions h is is2 ds _ _ _ m _)   | h /= HelpNotNeeded = return co++  | isCompileUnspecified m =+    compilerErrorM "Compiler mode must be specified explicitly."    | (not $ null $ is ++ is2) && (isExecuteTests m) =     compilerErrorM "Include paths (-i/-I) are not allowed in test mode (-t)."

@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -40,14 +40,22 @@   runCompiler :: (PathIOHandler r, CompilerBackend b) => r -> b -> CompileOptions -> TrackedErrorsIO ()-runCompiler resolver backend (CompileOptions _ _ _ ds _ _ p (ExecuteTests tp) f) = do+runCompiler resolver backend (CompileOptions _ _ _ ds _ _ p (ExecuteTests tp cl) f) = do   base <- resolveBaseModule resolver   ts <- fmap snd $ foldM (preloadTests base) (Map.empty,[]) ds   checkTestFilters ts-  allResults <- fmap concat $ mapCompilerM (runModuleTests resolver backend base tp) ts+  cl2 <- prepareCallLog cl+  allResults <- fmap concat $ mapCompilerM (runModuleTests resolver backend cl2 base tp) ts   let passed = sum $ map (fst . fst) allResults   let failed = sum $ map (snd . fst) allResults   processResults passed failed (mapCompilerM_ snd allResults) where+    prepareCallLog (Just cl2) = do+      clFull <- errorFromIO $ canonicalizePath (p </> cl2)+      compilerWarningM $ "Logging calls to " ++ clFull+      errorFromIO $ writeFile clFull (intercalate "," (map show logHeader) ++ "\n")+      return clFull+    prepareCallLog _ = return ""+    logHeader = ["microseconds","pid","function","context"]     compilerHash = getCompilerHash backend     preloadTests base (ca,ms) d = do       m <- loadModuleMetadata compilerHash f ca (p </> d)

@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -47,10 +47,10 @@ import Types.TypeCategory  -runSingleTest :: CompilerBackend b => b -> LanguageModule SourceContext ->-  FilePath -> [FilePath] -> [CompileMetadata] -> (String,String) ->-  TrackedErrorsIO ((Int,Int),TrackedErrors ())-runSingleTest b cm p paths deps (f,s) = do+runSingleTest :: CompilerBackend b => b -> FilePath ->+  LanguageModule SourceContext -> FilePath -> [FilePath] -> [CompileMetadata] ->+  (String,String) -> TrackedErrorsIO ((Int,Int),TrackedErrors ())+runSingleTest b cl cm p 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@@ -146,7 +146,7 @@            return results      executeTest binary rs es res s2 (f2,c) = printOutcome $ "\nIn unittest " ++ show f2 ++ formatFullContextBrace c ??> do-      let command = TestCommand binary (takeDirectory binary) [show f2]+      let command = TestCommand binary (takeDirectory binary) [show f2,cl]       (TestCommandResult s2' out err) <- runTestCommand b command       case (s2,s2') of            (True,False) -> collectAllM_ $ (asCompilerError res):(map compilerErrorM $ err ++ out)

@@ -27,7 +27,6 @@   CompilerContext(..),   CompiledData(..),   CompilerState,-  ExpressionType,   LoopSetup(..),   JumpType(..),   MemberValue(..),@@ -90,7 +89,6 @@  import Base.CompilerError import Base.GeneralType-import Base.Positional import Types.DefinedCategory import Types.Procedure import Types.TypeCategory@@ -110,7 +108,7 @@   ccGetRequired :: a -> m (Set.Set CategoryName)   ccGetCategoryFunction :: a -> [c] -> Maybe CategoryName -> FunctionName -> m (ScopedFunction c)   ccGetTypeFunction :: a -> [c] -> Maybe GeneralInstance -> FunctionName -> m (ScopedFunction c)-  ccCheckValueInit :: a -> [c] -> TypeInstance -> ExpressionType -> Positional GeneralInstance -> m ()+  ccCheckValueInit :: a -> [c] -> TypeInstance -> ExpressionType -> m ()   ccGetVariable :: a -> UsedVariable c -> m (VariableValue c)   ccAddVariable :: a -> UsedVariable c -> VariableValue c -> m a   ccSetReadOnly :: a -> UsedVariable c -> m a@@ -139,8 +137,6 @@   ccSetNoTrace :: a -> Bool -> m a   ccGetNoTrace :: a -> m Bool -type ExpressionType = Positional ValueType- data MemberValue c =   MemberValue {     mvContext :: [c],@@ -224,8 +220,8 @@ csGetTypeFunction c t n = fmap (\x -> ccGetTypeFunction x c t n) get >>= lift  csCheckValueInit :: CompilerContext c m s a =>-  [c] -> TypeInstance -> ExpressionType -> Positional GeneralInstance -> CompilerState a m ()-csCheckValueInit c t as ps = fmap (\x -> ccCheckValueInit x c t as ps) get >>= lift+  [c] -> TypeInstance -> ExpressionType -> CompilerState a m ()+csCheckValueInit c t as = fmap (\x -> ccCheckValueInit x c t as) get >>= lift  csGetVariable :: CompilerContext c m s a =>   UsedVariable c -> CompilerState a m (VariableValue c)

@@ -29,7 +29,7 @@   updateReturnVariables, ) where -import Control.Monad (when)+import Control.Monad (foldM,when) import Lens.Micro hiding (mapped) import Lens.Micro.TH import Data.Maybe (fromJust,isJust)@@ -65,12 +65,10 @@     _pcScope :: SymbolScope,     _pcType :: CategoryName,     _pcExtParams :: Positional (ValueParam c),-    _pcIntParams :: Positional (ValueParam c),     _pcMembers :: [DefinedMember c],     _pcCategories :: CategoryMap c,     _pcAllFilters :: ParamFilters,     _pcExtFilters :: [ParamFilter c],-    _pcIntFilters :: [ParamFilter c],     _pcParamScopes :: Map.Map ParamName SymbolScope,     _pcFunctions :: Map.Map FunctionName (ScopedFunction c),     _pcVariables :: Map.Map VariableName (VariableValue c),@@ -134,7 +132,7 @@   ccGetTypeFunction ctx c t n = do     t' <- case ctx ^. pcScope of                CategoryScope -> case t of-                                     Nothing -> compilerErrorM $ "Category " ++ show t +++                                     Nothing -> compilerErrorM $ "Category " ++ show (ctx ^. pcType) ++                                                                   " does not have a category function named " ++ show n ++                                                                   formatFullContextBrace c                                      Just t0 -> return t0@@ -190,7 +188,7 @@         compilerErrorM $ "Category " ++ show t2 ++                          " does not have a type or value function named " ++ show n ++                          formatFullContextBrace c-  ccCheckValueInit ctx c (TypeInstance t as) ts ps+  ccCheckValueInit ctx c (TypeInstance t as) ts     | t /= ctx ^. pcType =       compilerErrorM $ "Category " ++ show (ctx ^. pcType) ++ " cannot initialize values from " ++                      show t ++ formatFullContextBrace c@@ -199,26 +197,12 @@       r <- ccResolver ctx       allFilters <- ccAllFilters ctx       pa  <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ ctx ^. pcExtParams) as-      pa2 <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ ctx ^. pcIntParams) ps-      let pa' = Map.union pa pa2-      validateTypeInstance r allFilters t'-      -- Check internal param substitution.-      let mapped = Map.fromListWith (++) $ map (\f -> (pfParam f,[pfFilter f])) (ctx ^. pcIntFilters)-      let positional = map (getFilters mapped) (map vpParam $ pValues $ ctx ^. pcIntParams)-      assigned <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ ctx ^. pcIntParams) ps-      subbed <- fmap Positional $ mapCompilerM (assignFilters assigned) positional-      processPairs_ (validateAssignment r allFilters) ps subbed+      validateTypeInstanceForCall r allFilters t'       -- Check initializer types.-      ms <- fmap Positional $ mapCompilerM (subSingle pa') (ctx ^. pcMembers)+      ms <- fmap Positional $ mapCompilerM (subSingle pa) (ctx ^. pcMembers)       processPairs_ (checkInit r allFilters) ms (Positional $ zip ([1..] :: [Int]) $ pValues ts)       return ()       where-        getFilters fm n =-          case n `Map.lookup` fm of-              (Just fs) -> fs-              _ -> []-        assignFilters fm fs = do-          mapCompilerM (uncheckedSubFilter $ getValueForParam fm) fs         checkInit r fa (MemberValue c2 n t0) (i,t1) = do           checkValueAssignment r fa t1 t0 <??             "In initializer " ++ show i ++ " for " ++ show n ++ formatFullContextBrace c2@@ -227,6 +211,9 @@           return $ MemberValue c2 n t2'   ccGetVariable ctx (UsedVariable c n) =     case n `Map.lookup` (ctx ^. pcVariables) of+           (Just (VariableValue _ _ _ (VariableHidden []))) ->+             compilerErrorM $ "Variable " ++ show n ++ formatFullContextBrace c +++                              " is hidden"            (Just (VariableValue _ _ _ (VariableHidden c2))) ->              compilerErrorM $ "Variable " ++ show n ++ formatFullContextBrace c ++                               " was explicitly hidden at " ++ formatFullContext c2@@ -391,12 +378,12 @@ updateArgVariables ma as1 as2 = do   as <- processPairs alwaysPair as1 (avNames as2)   let as' = filter (not . isDiscardedInput . snd) as-  foldr update (return ma) as' where-    update (PassedValue c t,a) va = do-      va' <- va-      case ivName a `Map.lookup` va' of-            Nothing -> return $ Map.insert (ivName a) (VariableValue c LocalScope t (VariableReadOnly c)) va'+  foldM update ma as' where+    update va (PassedValue _ t,a) = do+      let c = ivContext a+      case ivName a `Map.lookup` va of+            Nothing -> return $ Map.insert (ivName a) (VariableValue c LocalScope t (VariableReadOnly c)) va             (Just v) -> compilerErrorM $ "Variable " ++ show (ivName a) ++-                                       formatFullContextBrace (ivContext a) ++-                                       " is already defined" ++-                                       formatFullContextBrace (vvContext v)+                                         formatFullContextBrace c +++                                         " is already defined" +++                                         formatFullContextBrace (vvContext v)

@@ -26,9 +26,8 @@   getProcedureScopes, ) where -import Control.Monad (when)-import Prelude hiding (pi) import qualified Data.Map as Map+import qualified Data.Set as Set  import Base.CompilerError import Base.GeneralType@@ -44,11 +43,9 @@   ScopeContext {     scCategories :: CategoryMap c,     scName :: CategoryName,-    scExternalParams :: Positional (ValueParam c),-    scInternalparams :: Positional (ValueParam c),+    scParams :: Positional (ValueParam c),     scValueMembers :: [DefinedMember c],-    scExternalFilters :: [ParamFilter c],-    scInternalFilters :: [ParamFilter c],+    scFilters :: [ParamFilter c],     scFunctions :: Map.Map FunctionName (ScopedFunction c),     scVariables :: Map.Map VariableName (VariableValue c),     scExprMap :: ExprMap c@@ -66,17 +63,13 @@  getProcedureScopes :: (Show c, CollectErrorsM m) =>   CategoryMap c -> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]-getProcedureScopes ta em (DefinedCategory c n pi _ _ fi ms ps fs) = do+getProcedureScopes ta em (DefinedCategory c n pragmas _ _ ms ps fs) = do   (_,t) <- getConcreteCategory ta (c,n)   let params = Positional $ getCategoryParams t-  let params2 = Positional pi   let typeInstance = TypeInstance n $ fmap (singleType . JustParamName False . vpParam) params   let filters = getCategoryFilters t-  let filters2 = fi   let r = CategoryResolver ta   fa <- setInternalFunctions r t fs-  fm <- getCategoryFilterMap t-  checkInternalParams pi fi (getCategoryParams t) (Map.elems fa) r fm   pa <- pairProceduresToFunctions fa ps   let (cp,tp,vp) = partitionByScope (sfScope . fst) pa   tp' <- mapCompilerM (firstM $ replaceSelfFunction (instanceFromCategory t)) tp@@ -87,39 +80,35 @@   let cm0 = builtins typeInstance CategoryScope   let tm0 = builtins typeInstance TypeScope   let vm0 = builtins typeInstance ValueScope-  cm2 <- mapMembers cm-  tm2 <- mapMembers $ cm ++ tm'-  vm2 <- mapMembers $ cm ++ tm' ++ vm'+  cm2 <- mapMembers readOnly hidden cm+  tm2 <- mapMembers readOnly hidden $ cm ++ tm'+  vm2 <- mapMembers readOnly hidden $ cm ++ tm' ++ vm'+  mapCompilerM_ checkPragma pragmas   let cv = Map.union cm0 cm2   let tv = Map.union tm0 tm2   let vv = Map.union vm0 vm2-  let ctxC = ScopeContext ta n params params2 vm' filters filters2 fa cv em-  let ctxT = ScopeContext ta n params params2 vm' filters filters2 fa tv em-  let ctxV = ScopeContext ta n params params2 vm' filters filters2 fa vv em+  let ctxC = ScopeContext ta n params vm' filters fa cv em+  let ctxT = ScopeContext ta n params vm' filters fa tv em+  let ctxV = ScopeContext ta n params vm' filters fa vv em   return [ProcedureScope ctxC cp,ProcedureScope ctxT tp',ProcedureScope ctxV vp']   where+    checkPragma (MembersReadOnly c2 vs) = do+      let missing = Set.toList $ Set.fromList vs `Set.difference` allMembers+      mapCompilerM_ (\v -> compilerErrorM $ "Member " ++ show v +++                                            " does not exist (marked ReadOnly at " +++                                            formatFullContext c2 ++ ")") missing+    checkPragma (MembersHidden c2 vs) = do+      let missing = Set.toList $ Set.fromList vs `Set.difference` allMembers+      mapCompilerM_ (\v -> compilerErrorM $ "Member " ++ show v +++                                            " does not exist (marked Hidden at " +++                                            formatFullContext c2 ++ ")") missing+    allMembers = Set.fromList $ map dmName ms+    readOnly = Map.fromListWith (++) $ concat $ map (\m -> zip (mroMembers m) (repeat $ mroContext m)) $ filter isMembersReadOnly pragmas+    hidden   = Map.fromListWith (++) $ concat $ map (\m -> zip (mhMembers m)  (repeat $ mhContext m))  $ filter isMembersHidden   pragmas     firstM f (x,y) = do       x' <- f x       return (x',y)     builtins t s0 = Map.filter ((<= s0) . vvScope) $ builtinVariables t-    checkInternalParams pi2 fi2 pe fs2 r fa = do-      let pm = Map.fromList $ map (\p -> (vpParam p,vpContext p)) pi2-      mapCompilerM_ (checkFunction pm) fs2-      mapCompilerM_ (checkParam pm) pe-      fa' <- fmap (Map.union fa) $ getFilterMap pi2 fi2-      mapCompilerM_ (checkFilter r fa') fi2-    checkFilter r fa (ParamFilter c2 n2 f) =-      validateTypeFilter r fa f <?? "In " ++ show n2 ++ " " ++ show f ++ formatFullContextBrace c2-    checkFunction pm f =-      when (sfScope f == ValueScope) $-        mapCompilerM_ (checkParam pm) $ pValues $ sfParams f-    checkParam pm p =-      case vpParam p `Map.lookup` pm of-           Nothing -> return ()-           (Just c2) -> compilerErrorM $ "Internal param " ++ show (vpParam p) ++-                                        formatFullContextBrace (vpContext p) ++-                                        " is already defined at " ++-                                        formatFullContext c2  -- TODO: This is probably in the wrong module. builtinVariables :: TypeInstance -> Map.Map VariableName (VariableValue c)

@@ -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.@@ -34,7 +34,7 @@ import Compilation.CompilerState import Compilation.ProcedureContext import Compilation.ScopeContext-import CompilerCxx.Code+import Types.Builtin import Types.DefinedCategory import Types.Procedure import Types.TypeCategory@@ -57,17 +57,16 @@   fm <- getFilterMap (pValues ps) pa   let typeInstance = TypeInstance (getCategoryName t) $ fmap (singleType . JustParamName False . vpParam) ps   let builtin = Map.filter ((== LocalScope) . vvScope) $ builtinVariables typeInstance-  members <- mapMembers $ filter ((<= s) . dmScope) (dcMembers d)+  let readOnly = Map.fromListWith (++) $ map (\m -> (dmName m,[])) $ dcMembers d+  members <- mapMembers readOnly Map.empty $ filter ((<= s) . dmScope) (dcMembers d)   return $ ProcedureContext {       _pcScope = s,       _pcType = getCategoryName t,       _pcExtParams = ps,-      _pcIntParams = Positional [],       _pcMembers = ms,       _pcCategories = tm,       _pcAllFilters = fm,       _pcExtFilters = pa,-      _pcIntFilters = [],       _pcParamScopes = sa,       _pcFunctions = fa,       _pcVariables = Map.union builtin members,@@ -89,7 +88,7 @@  getProcedureContext :: (Show c, CollectErrorsM m) =>   ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> m (ProcedureContext c)-getProcedureContext (ScopeContext tm t ps pi ms pa fi fa va em)+getProcedureContext (ScopeContext tm t ps ms pa fa va em)                     ff@(ScopedFunction _ _ _ s as1 rs1 ps1 fs _)                     (ExecutableProcedure _ _ _ _ as2 rs2 _) = do   rs' <- if isUnnamedReturns rs2@@ -102,35 +101,30 @@                else pa ++ fs   let localScopes = Map.fromList $ zip (map vpParam $ pValues ps1) (repeat LocalScope)   let typeScopes = Map.fromList $ zip (map vpParam $ pValues ps) (repeat TypeScope)-  let valueScopes = Map.fromList $ zip (map vpParam $ pValues pi) (repeat ValueScope)   let sa = case s of                 CategoryScope -> localScopes-                TypeScope -> Map.union typeScopes localScopes-                ValueScope -> Map.unions [localScopes,typeScopes,valueScopes]+                TypeScope     -> Map.union typeScopes localScopes+                ValueScope    -> Map.union typeScopes localScopes                 _ -> undefined   localFilters <- getFunctionFilterMap ff   typeFilters <- getFilterMap (pValues ps) pa-  valueFilters <- getFilterMap (pValues pi) fi   let allFilters = case s of                    CategoryScope -> localFilters-                   TypeScope -> Map.union localFilters typeFilters-                   ValueScope -> Map.unions [localFilters,typeFilters,valueFilters]+                   TypeScope     -> Map.union localFilters typeFilters+                   ValueScope    -> Map.union localFilters typeFilters                    _ -> undefined   let ns0 = if isUnnamedReturns rs2                then []                else zipWith3 ReturnVariable [0..] (map ovName $ pValues $ nrNames rs2) (map pvType $ pValues rs1)-  let ns = filter (isPrimType . rvType) ns0+  let ns = filter (isPrimitiveType . rvType) ns0   return $ ProcedureContext {       _pcScope = s,       _pcType = t,       _pcExtParams = ps,-      _pcIntParams = pi,       _pcMembers = ms,       _pcCategories = tm,       _pcAllFilters = allFilters,       _pcExtFilters = pa',-      -- fs is duplicated so value initialization checks work properly.-      _pcIntFilters = fi ++ fs,       _pcParamScopes = sa,       _pcFunctions = fa,       _pcVariables = va'',@@ -157,12 +151,10 @@     _pcScope = LocalScope,     _pcType = CategoryNone,     _pcExtParams = Positional [],-    _pcIntParams = Positional [],     _pcMembers = [],     _pcCategories = tm,     _pcAllFilters = Map.empty,     _pcExtFilters = [],-    _pcIntFilters = [],     _pcParamScopes = Map.empty,     _pcFunctions = Map.empty,     _pcVariables = Map.empty,

@@ -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.@@ -19,8 +19,6 @@ {-# LANGUAGE Safe #-}  module CompilerCxx.Code (-  ExprValue(..),-  PrimitiveType(..),   categoryBase,   captureCreationTrace,   clearCompiled,@@ -29,7 +27,6 @@   escapeChars,   functionLabelType,   indentCompiled,-  isPrimType,   newFunctionLabel,   noTestsOnlySourceGuard,   onlyCode,@@ -88,8 +85,8 @@ clearCompiled :: CompiledData [String] -> CompiledData [String] clearCompiled (CompiledData r _) = CompiledData r [] -startFunctionTracing :: ScopedFunction c -> String-startFunctionTracing f = "TRACE_FUNCTION(" ++ show (functionDebugName f) ++ ")"+startFunctionTracing :: CategoryName -> ScopedFunction c -> String+startFunctionTracing t f = "TRACE_FUNCTION(" ++ show (functionDebugName t f) ++ ")"  startMainTracing :: String -> String startMainTracing n = "TRACE_FUNCTION(" ++ show n ++ ")"@@ -113,38 +110,13 @@   | null c = ""   | otherwise = "PRED_CONTEXT_POINT(" ++ escapeChars (formatFullContext c) ++ ")" -captureCreationTrace :: String-captureCreationTrace = "CAPTURE_CREATION"+captureCreationTrace :: CategoryName -> String+captureCreationTrace n = "CAPTURE_CREATION(" ++ show (show n) ++ ")"  showCreationTrace :: String showCreationTrace = "TRACE_CREATION" -data PrimitiveType =-  PrimBool |-  PrimString |-  PrimChar |-  PrimInt |-  PrimFloat-  deriving (Eq,Show)--isPrimType :: ValueType -> Bool-isPrimType t-  | t == boolRequiredValue  = True-  | t == intRequiredValue   = True-  | t == floatRequiredValue = True-  | t == charRequiredValue  = True-  | otherwise               = False--data ExprValue =-  OpaqueMulti String |-  WrappedSingle String |-  UnwrappedSingle String |-  BoxedPrimitive PrimitiveType String |-  UnboxedPrimitive PrimitiveType String |-  LazySingle ExprValue-  deriving (Show)--getFromLazy :: ExprValue -> ExprValue+getFromLazy :: ExpressionValue -> ExpressionValue getFromLazy (OpaqueMulti e)        = OpaqueMulti $ e ++ ".Get()" getFromLazy (WrappedSingle e)      = WrappedSingle $ e ++ ".Get()" getFromLazy (UnwrappedSingle e)    = UnwrappedSingle $ e ++ ".Get()"@@ -152,7 +124,7 @@ getFromLazy (UnboxedPrimitive t e) = UnboxedPrimitive t  $ e ++ ".Get()" getFromLazy (LazySingle e)         = LazySingle $ getFromLazy e -useAsWhatever :: ExprValue -> String+useAsWhatever :: ExpressionValue -> String useAsWhatever (OpaqueMulti e)        = e useAsWhatever (WrappedSingle e)      = e useAsWhatever (UnwrappedSingle e)    = e@@ -160,7 +132,7 @@ useAsWhatever (UnboxedPrimitive _ e) = e useAsWhatever (LazySingle e)         = useAsWhatever $ getFromLazy e -useAsReturns :: ExprValue -> String+useAsReturns :: ExpressionValue -> String useAsReturns (OpaqueMulti e)                 = "(" ++ e ++ ")" useAsReturns (WrappedSingle e)               = "ReturnTuple(" ++ e ++ ")" useAsReturns (UnwrappedSingle e)             = "ReturnTuple(" ++ e ++ ")"@@ -176,7 +148,7 @@ useAsReturns (UnboxedPrimitive PrimFloat e)  = "ReturnTuple(Box_Float(" ++ e ++ "))" useAsReturns (LazySingle e)                  = useAsReturns $ getFromLazy e -useAsArgs :: ExprValue -> String+useAsArgs :: ExpressionValue -> String useAsArgs (OpaqueMulti e)                 = "(" ++ e ++ ")" useAsArgs (WrappedSingle e)               = "ArgTuple(" ++ e ++ ")" useAsArgs (UnwrappedSingle e)             = "ArgTuple(" ++ e ++ ")"@@ -192,7 +164,7 @@ useAsArgs (UnboxedPrimitive PrimFloat e)  = "ArgTuple(Box_Float(" ++ e ++ "))" useAsArgs (LazySingle e)                  = useAsArgs $ getFromLazy e -useAsUnwrapped :: ExprValue -> String+useAsUnwrapped :: ExpressionValue -> String useAsUnwrapped (OpaqueMulti e)                 = "(" ++ e ++ ").Only()" useAsUnwrapped (WrappedSingle e)               = "(" ++ e ++ ")" useAsUnwrapped (UnwrappedSingle e)             = "(" ++ e ++ ")"@@ -203,32 +175,32 @@ useAsUnwrapped (BoxedPrimitive PrimFloat e)    = "Box_Float(" ++ e ++ ")" useAsUnwrapped (UnboxedPrimitive PrimBool e)   = "Box_Bool(" ++ e ++ ")" useAsUnwrapped (UnboxedPrimitive PrimString e) = "Box_String(" ++ e ++ ")"-useAsUnwrapped (UnboxedPrimitive PrimChar e) = "Box_Char(" ++ e ++ ")"+useAsUnwrapped (UnboxedPrimitive PrimChar e)   = "Box_Char(" ++ e ++ ")" useAsUnwrapped (UnboxedPrimitive PrimInt e)    = "Box_Int(" ++ e ++ ")" useAsUnwrapped (UnboxedPrimitive PrimFloat e)  = "Box_Float(" ++ e ++ ")" useAsUnwrapped (LazySingle e)                  = useAsUnwrapped $ getFromLazy e -useAsUnboxed :: PrimitiveType -> ExprValue -> 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 :: 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 t (LazySingle e) = useAsUnboxed t $ getFromLazy e+useAsUnboxed _ (BoxedPrimitive _ e)         = "(" ++ e ++ ")"+useAsUnboxed _ (UnboxedPrimitive _ e)       = "(" ++ e ++ ")"+useAsUnboxed t (LazySingle e)               = useAsUnboxed t $ getFromLazy e -valueAsWrapped :: ExprValue -> ExprValue+valueAsWrapped :: ExpressionValue -> ExpressionValue valueAsWrapped (UnwrappedSingle e)             = WrappedSingle e valueAsWrapped (BoxedPrimitive _ e)            = WrappedSingle e valueAsWrapped (UnboxedPrimitive PrimBool e)   = WrappedSingle $ "Box_Bool(" ++ e ++ ")"@@ -239,7 +211,7 @@ valueAsWrapped (LazySingle e)                  = valueAsWrapped $ getFromLazy e valueAsWrapped v                               = v -valueAsUnwrapped :: ExprValue -> ExprValue+valueAsUnwrapped :: ExpressionValue -> ExpressionValue valueAsUnwrapped (OpaqueMulti e)                 = UnwrappedSingle $ "(" ++ e ++ ").Only()" valueAsUnwrapped (WrappedSingle e)               = UnwrappedSingle e valueAsUnwrapped (UnboxedPrimitive PrimBool e)   = UnwrappedSingle $ "Box_Bool(" ++ e ++ ")"@@ -271,21 +243,21 @@   | isWeakValue t            = "W<TypeValue>&"   | otherwise                = "S<TypeValue>&" -readStoredVariable :: Bool -> ValueType -> String -> ExprValue+readStoredVariable :: Bool -> ValueType -> String -> ExpressionValue readStoredVariable True t s = LazySingle $ readStoredVariable False t s readStoredVariable False t s-  | t == boolRequiredValue   = UnboxedPrimitive PrimBool s-  | t == intRequiredValue    = UnboxedPrimitive PrimInt s+  | t == boolRequiredValue   = UnboxedPrimitive PrimBool  s+  | t == intRequiredValue    = UnboxedPrimitive PrimInt   s   | t == floatRequiredValue  = UnboxedPrimitive PrimFloat s-  | t == charRequiredValue   = UnboxedPrimitive PrimChar s+  | t == charRequiredValue   = UnboxedPrimitive PrimChar  s   | otherwise                = UnwrappedSingle s -writeStoredVariable :: ValueType -> ExprValue -> String+writeStoredVariable :: ValueType -> ExpressionValue -> String writeStoredVariable t e-  | t == boolRequiredValue   = useAsUnboxed PrimBool e-  | t == intRequiredValue    = useAsUnboxed PrimInt e+  | t == boolRequiredValue   = useAsUnboxed PrimBool  e+  | t == intRequiredValue    = useAsUnboxed PrimInt   e   | t == floatRequiredValue  = useAsUnboxed PrimFloat e-  | t == charRequiredValue   = useAsUnboxed PrimChar e+  | t == charRequiredValue   = useAsUnboxed PrimChar  e   | otherwise                = useAsUnwrapped e  functionLabelType :: ScopedFunction c -> String

@@ -87,17 +87,17 @@   return (dec:def)  generateNativeInterface :: (Ord c, Show c, CollectErrorsM m) =>-  Bool -> AnyCategory c -> m [CxxOutput]-generateNativeInterface testing t = do-  dec <- compileCategoryDeclaration testing Set.empty t+  Bool -> Set.Set Namespace -> AnyCategory c -> m [CxxOutput]+generateNativeInterface testing ns t = do+  dec <- compileCategoryDeclaration testing ns t   def <- generateCategoryDefinition testing (NativeInterface t)   return (dec:def)  generateStreamlinedExtension :: (Ord c, Show c, CollectErrorsM m) =>-  Bool -> AnyCategory c -> m [CxxOutput]-generateStreamlinedExtension testing t = do-  dec <- compileCategoryDeclaration testing Set.empty t-  def <- generateCategoryDefinition testing (StreamlinedExtension t)+  Bool -> Set.Set Namespace -> AnyCategory c -> m [CxxOutput]+generateStreamlinedExtension testing ns t = do+  dec <- compileCategoryDeclaration testing ns t+  def <- generateCategoryDefinition testing (StreamlinedExtension t ns)   return (dec:def)  generateVerboseExtension :: (Ord c, Show c, CollectErrorsM m) =>@@ -106,8 +106,8 @@   fmap (:[]) $ compileCategoryDeclaration testing Set.empty t  generateStreamlinedTemplate :: (Ord c, Show c, CollectErrorsM m) =>-  FileContext c -> AnyCategory c -> m [CxxOutput]-generateStreamlinedTemplate (FileContext testing tm _ _) t =+  Bool -> CategoryMap c -> AnyCategory c -> m [CxxOutput]+generateStreamlinedTemplate testing tm t =   generateCategoryDefinition testing (StreamlinedTemplate t tm)  compileCategoryDeclaration :: (Ord c, Show c, CollectErrorsM m) =>@@ -160,7 +160,8 @@     ncExprMap :: ExprMap c   } |   StreamlinedExtension {-    seCategory :: AnyCategory c+    seCategory :: AnyCategory c,+    ncNamespaces :: Set.Set Namespace   } |   StreamlinedTemplate {     stCategory :: AnyCategory c,@@ -192,32 +193,21 @@                          (Set.fromList [getCategoryNamespace t])                          req'                          (allowTestsOnly $ addSourceIncludes $ addCategoryHeader t $ addIncludes req' out)-  common (StreamlinedExtension t) = sequence [streamlinedHeader,streamlinedSource] where+  common (StreamlinedExtension t ns) = sequence [streamlinedHeader,streamlinedSource] where     streamlinedHeader = do       let filename = headerStreamlined (getCategoryName t)       (CompiledData req out) <- fmap (addNamespace t) $ concatM [           defineAbstractCategory t,           defineAbstractType     t,-          defineAbstractValue    t defined,+          defineAbstractValue    t,           declareAbstractGetters t         ]       return $ CxxOutput (Just $ getCategoryName t)                          filename                          (getCategoryNamespace t)-                         (Set.fromList [getCategoryNamespace t])+                         (getCategoryNamespace t `Set.insert` ns)                          req                          (headerGuard (getCategoryName t) $ allowTestsOnly $ addSourceIncludes $ addCategoryHeader t $ addIncludes req out)-    defined = DefinedCategory {-        dcContext = [],-        dcName = getCategoryName t,-        dcParams = [],-        dcRefines = [],-        dcDefines = [],-        dcParamFilter = [],-        dcMembers = [],-        dcProcedures = [],-        dcFunctions = []-      }     streamlinedSource = do       let filename = sourceStreamlined (getCategoryName t)       let (cf,tf,vf) = partitionByScope sfScope $ getCategoryFunctions t@@ -232,7 +222,7 @@       return $ CxxOutput (Just $ getCategoryName t)                          filename                          (getCategoryNamespace t)-                         (Set.fromList [getCategoryNamespace t])+                         (getCategoryNamespace t `Set.insert` ns)                          req'                          (addSourceIncludes $ addStreamlinedHeader t $ addIncludes req' out)   common (StreamlinedTemplate t tm) = fmap (:[]) streamlinedTemplate where@@ -256,11 +246,10 @@     filename = templateStreamlined (getCategoryName t)     defined = DefinedCategory {         dcContext = [],+        dcPragmas = [],         dcName = getCategoryName t,-        dcParams = [],         dcRefines = [],         dcDefines = [],-        dcParamFilter = [],         dcMembers = [],         dcProcedures = map defaultFail (getCategoryFunctions t),         dcFunctions = []@@ -276,12 +265,12 @@       }     createArg = InputValue [] . VariableName . ("arg" ++) . show     failProcedure f = Procedure [] $ [-        asLineComment $ "TODO: Implement " ++ functionDebugName f ++ "."+        asLineComment $ "TODO: Implement " ++ functionDebugName (getCategoryName t) f ++ "."       ] ++ map asLineComment (formatFunctionTypes f) ++ [-        RawFailCall (functionDebugName f ++ " is not implemented (see " ++ filename ++ ")")+        RawFailCall (functionDebugName (getCategoryName t) f ++ " is not implemented (see " ++ filename ++ ")")       ]     asLineComment = NoValueExpression [] . LineComment-  common (NativeConcrete t d@(DefinedCategory _ _ pi _ _ fi ms _ _) ta ns em) = fmap (:[]) singleSource where+  common (NativeConcrete t d@(DefinedCategory _ _ _ _ _ ms _ _) ta ns em) = fmap (:[]) singleSource where     singleSource = do       let filename = sourceFilename (getCategoryName t)       ta' <- mergeInternalInheritance ta d@@ -289,18 +278,16 @@       [cp,tp,vp] <- getProcedureScopes ta' em d       let (_,tm,_) = partitionByScope dmScope ms       disallowTypeMembers tm-      let filters = getCategoryFilters t-      let filters2 = fi-      allFilters <- getFilterMap (getCategoryParams t ++ pi) $ filters ++ filters2+      params <- getCategoryParamSet t       let cf = map fst $ psProcedures cp       let tf = map fst $ psProcedures tp       let vf = map fst $ psProcedures vp       (CompiledData req out) <- fmap (addNamespace t) $ concatM [           defineFunctions t cf tf vf,           declareInternalGetters t,-          defineConcreteCategory r allFilters cf ta' em t d,+          defineConcreteCategory r cf ta' em t d,           defineConcreteType tf t,-          defineConcreteValue r allFilters vf t d,+          defineConcreteValue r params vf t d,           defineCategoryOverrides t cf,           defineTypeOverrides     t tf,           defineValueOverrides    t vf,@@ -385,17 +372,18 @@       return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ " : public " ++ typeBase ++ " {",       fmap indentCompiled $ inlineTypeConstructor t,       return declareTypeOverrides,+      return $ declareTypeArgGetters t,       return $ indentCompiled $ createParams $ getCategoryParams t,       return $ onlyCode $ "  " ++ categoryName (getCategoryName t) ++ "& parent;",       return $ onlyCode "};"     ] -  defineConcreteCategory r allFilters fs tm em t d = concatM [+  defineConcreteCategory r fs tm em t d = concatM [       return $ onlyCode $ "struct " ++ categoryName (getCategoryName t) ++ " : public " ++ categoryBase ++ " {",       fmap indentCompiled $ inlineCategoryConstructor t d tm em,       return declareCategoryOverrides,       fmap indentCompiled $ concatM $ map (procedureDeclaration False) fs,-      fmap indentCompiled $ concatM $ map (createMemberLazy r allFilters) members,+      fmap indentCompiled $ concatM $ map (createMemberLazy r) members,       return $ onlyCode "};"     ] where       members = filter ((== CategoryScope). dmScope) $ dcMembers d@@ -403,18 +391,18 @@       return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ " : public " ++ typeBase ++ " {",       fmap indentCompiled $ inlineTypeConstructor t,       return declareTypeOverrides,+      return $ declareTypeArgGetters t,       fmap indentCompiled $ concatM $ map (procedureDeclaration False) fs,       return $ indentCompiled $ createParams $ getCategoryParams t,       return $ onlyCode $ "  " ++ categoryName (getCategoryName t) ++ "& parent;",       return $ onlyCode "};"     ]-  defineConcreteValue r allFilters fs t d = concatM [+  defineConcreteValue r params fs t d = concatM [       return $ onlyCode $ "struct " ++ valueName (getCategoryName t) ++ " : public " ++ valueBase ++ " {",       fmap indentCompiled $ inlineValueConstructor t d,       return declareValueOverrides,       fmap indentCompiled $ concatM $ map (procedureDeclaration False) fs,-      fmap indentCompiled $ concatM $ map (createMember r allFilters t) members,-      return $ indentCompiled $ createParams $ dcParams d,+      fmap indentCompiled $ concatM $ map (createMember r params t) members,       return $ onlyCode $ "  const S<" ++ typeName (getCategoryName t) ++ "> parent;",       return $ onlyCodes traceCreation,       return $ onlyCode "};"@@ -422,7 +410,7 @@       members = filter ((== ValueScope). dmScope) $ dcMembers d       procedures = dcProcedures d       traceCreation-        | any isTraceCreation $ concat $ map epPragmas procedures = [captureCreationTrace]+        | any isTraceCreation $ concat $ map epPragmas procedures = [captureCreationTrace $ getCategoryName t]         | otherwise = []    defineAbstractCategory t = concatM [@@ -436,15 +424,16 @@       return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ " : public " ++ typeBase ++ " {",       fmap indentCompiled $ inlineTypeConstructor t,       return declareTypeOverrides,+      return $ declareTypeArgGetters t,       fmap indentCompiled $ concatM $ map (procedureDeclaration True) $ filter ((== TypeScope). sfScope) $ getCategoryFunctions t,       return $ onlyCode $ "  virtual inline ~" ++ typeName (getCategoryName t) ++ "() {}",       return $ indentCompiled $ createParams $ getCategoryParams t,       return $ onlyCode $ "  " ++ categoryName (getCategoryName t) ++ "& parent;",       return $ onlyCode "};"     ]-  defineAbstractValue t d = concatM [+  defineAbstractValue t = concatM [       return $ onlyCode $ "struct " ++ valueName (getCategoryName t) ++ " : public " ++ valueBase ++ " {",-      fmap indentCompiled $ abstractValueConstructor t d,+      fmap indentCompiled $ abstractValueConstructor t,       return declareValueOverrides,       fmap indentCompiled $ concatM $ map (procedureDeclaration True) $ filter ((== ValueScope). sfScope) $ getCategoryFunctions t,       return $ onlyCode $ "  virtual inline ~" ++ valueName (getCategoryName t) ++ "() {}",@@ -511,6 +500,7 @@       onlyCode $ "bool " ++ className ++ "::TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const {",       createTypeArgsForParent t,       onlyCode $ "}",+      defineTypeArgGetters t,       onlyCode $ "ReturnTuple " ++ className ++ "::Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) {",       createFunctionDispatch (getCategoryName t) TypeScope fs,       onlyCode $ "}",@@ -528,13 +518,13 @@     ] where       className = valueName (getCategoryName t) -  createMember r filters t m = do+  createMember r params t m = do     m' <- replaceSelfMember (instanceFromCategory t) m-    validateGeneralInstance r filters (vtType $ dmType m') <??+    validateGeneralInstance r params (vtType $ dmType m') <??       "In creation of " ++ show (dmName m') ++ " at " ++ formatFullContext (dmContext m')     return $ onlyCode $ variableStoredType (dmType m') ++ " " ++ variableName (dmName m') ++ ";"-  createMemberLazy r filters m = do-    validateGeneralInstance r filters (vtType $ dmType m) <??+  createMemberLazy r m = do+    validateGeneralInstance r Set.empty (vtType $ dmType m) <??       "In creation of " ++ show (dmName m) ++ " at " ++ formatFullContext (dmContext m)     return $ onlyCode $ variableLazyType (dmType m) ++ " " ++ variableName (dmName m) ++ ";" @@ -570,24 +560,20 @@       ]   inlineValueConstructor t d = do     let argParent = "S<" ++ typeName (getCategoryName t) ++ "> p"-    let paramsPassed = "const ParamTuple& params"     let argsPassed = "const ValueTuple& args"-    let allArgs = intercalate ", " [argParent,paramsPassed,argsPassed]+    let allArgs = intercalate ", " [argParent,argsPassed]     let initParent = "parent(p)"-    let initParams = map (\(i,p) -> paramName (vpParam p) ++ "(params.At(" ++ show i ++ "))") $ zip ([0..] :: [Int]) $ dcParams d     let initArgs = map (\(i,m) -> variableName (dmName m) ++ "(" ++ unwrappedArg i m ++ ")") $ zip ([0..] :: [Int]) members-    let allInit = intercalate ", " $ initParent:(initParams ++ initArgs)+    let allInit = intercalate ", " $ initParent:initArgs     return $ onlyCode $ "inline " ++ valueName (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}" where       unwrappedArg i m = writeStoredVariable (dmType m) (UnwrappedSingle $ "args.At(" ++ show i ++ ")")       members = filter ((== ValueScope). dmScope) $ dcMembers d -  abstractValueConstructor t d = do+  abstractValueConstructor t = do     let argParent = "S<" ++ typeName (getCategoryName t) ++ "> p"-    let paramsPassed = "const ParamTuple& params"-    let allArgs = intercalate ", " [argParent,paramsPassed]+    let allArgs = intercalate ", " [argParent]     let initParent = "parent(p)"-    let initParams = map (\(i,p) -> paramName (vpParam p) ++ "(params.At(" ++ show i ++ "))") $ zip ([0..] :: [Int]) $ dcParams d-    let allInit = intercalate ", " $ initParent:initParams+    let allInit = initParent     return $ onlyCode $ "inline " ++ valueName (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}"    customTypeConstructor t = do@@ -599,10 +585,9 @@     return $ onlyCode $ "inline " ++ typeCustom (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}"   customValueConstructor t = do     let argParent = "S<" ++ typeName (getCategoryName t) ++ "> p"-    let paramsPassed = "const ParamTuple& params"     let argsPassed = "const ValueTuple& args"-    let allArgs = intercalate ", " [argParent,paramsPassed,argsPassed]-    let allInit = valueName (getCategoryName t) ++ "(p, params)"+    let allArgs = intercalate ", " [argParent,argsPassed]+    let allInit = valueName (getCategoryName t) ++ "(p)"     return $ onlyCode $ "inline " ++ valueCustom (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}"    allowTestsOnly@@ -664,13 +649,14 @@   ts' <- fmap mconcat $ mapCompilerM (compileTestProcedure tm em) ts   (include,sel) <- selectTestFromArgv1 $ map tpName ts   let (CompiledData req _) = ts' <> sel-  let file = testsOnlySourceGuard ++ createMainCommon "testcase" (onlyCodes include <> ts') (argv <> sel)+  let file = testsOnlySourceGuard ++ createMainCommon "testcase" (onlyCodes include <> ts') (argv <> callLog <> sel)   return $ CompiledData req file where     args' = map escapeChars args     argv = onlyCodes [         "const char* argv2[] = { \"testcase\" " ++ concat (map (", " ++) args') ++ " };",         "ProgramArgv program_argv(sizeof argv2 / sizeof(char*), argv2);"       ]+    callLog = onlyCode "LogCallsToFile call_logger_((argc < 3)? \"\" : argv[2]);"  addNamespace :: AnyCategory c -> CompiledData [String] -> CompiledData [String] addNamespace t cs@@ -709,8 +695,7 @@ createFunctionDispatch :: CategoryName -> SymbolScope -> [ScopedFunction c] -> CompiledData [String] createFunctionDispatch n s fs = onlyCodes $ [typedef] ++                                             concat (map table $ byCategory) ++-                                            concat (map dispatch $ byCategory) ++-                                            [fallback] where+                                            metaTable ++ select where   filtered = filter ((== s) . sfScope) fs   flatten f = f:(concat $ map flatten $ sfMerges f)   flattened = concat $ map flatten filtered@@ -732,13 +717,20 @@     ["  static const CallType " ++ tableName n2 ++ "[] = {"] ++     map (\f -> "    &" ++ name f ++ ",") (Set.toList $ Set.fromList $ map sfName fs2) ++     ["  };"]-  dispatch (n2,_) = [-      "  if (label.collection == " ++ collectionName n2 ++ ") {",-      "    if (label.function_num < 0 || label.function_num >= sizeof " ++ tableName n2 ++ " / sizeof(CallType)) {",+  metaTable = ["  static DispatchTable<CallType> all_tables[] = {"] +++              map dispatchKeyValue byCategory +++              ["    DispatchTable<CallType>(),","  };"]+  dispatchKeyValue (n2,_) = "    DispatchTable<CallType>(" ++ collectionName n2 ++ ", " ++ tableName n2 ++ "),"+  select = [+      "  const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);",+      "  if (table) {",+      "    if (label.function_num < 0 || label.function_num >= table->size) {",       "      FAIL() << \"Bad function call \" << label;",+      "    } else {",+      "      return (this->*table->table[label.function_num])(" ++ args ++ ");",       "    }",-      "    return (this->*" ++ tableName n2 ++ "[label.function_num])(" ++ args ++ ");",-      "  }"+      "  }",+      fallback     ]   args     | s == CategoryScope = "params, args"@@ -769,22 +761,42 @@       checkCov i p = "  if (!TypeInstance::CanConvert(args[" ++ show i ++ "], " ++ paramName p ++ ")) return false;"       checkCon i p = "  if (!TypeInstance::CanConvert(" ++ paramName p ++ ", args[" ++ show i ++ "])) return false;" +declareTypeArgGetters :: AnyCategory c -> CompiledData [String]+declareTypeArgGetters t = onlyCodes $ map paramGetter (getCategoryName t:refines) where+  refines = map (tiName  . vrType) $ getCategoryRefines t+  paramGetter r = "  void Params_" ++ show r ++ "(std::vector<S<const TypeInstance>>& args) const;"++defineTypeArgGetters :: AnyCategory c -> CompiledData [String]+defineTypeArgGetters t = onlyCodes $ concat $ map paramGetter (myType:refines) where+  params = map (\p -> (vpParam p,vpVariance p)) $ getCategoryParams t+  myType = (getCategoryName t,map (singleType . JustParamName False . fst) params)+  refines = map (\r -> (tiName r,pValues $ tiParams r)) $ map vrType $ getCategoryRefines t+  paramGetter (r,ps) = [+      "void " ++ typeName (getCategoryName t) ++ "::Params_" ++ show r ++ "(std::vector<S<const TypeInstance>>& args) const {",+      "  args = std::vector<S<const TypeInstance>>{" ++ intercalate ", " (map expandLocalType ps) ++ "};",+      "}"+    ]+ createTypeArgsForParent :: AnyCategory c -> CompiledData [String] createTypeArgsForParent t-  | isInstanceInterface t = onlyCode $ "  return " ++ typeBase ++ "::TypeArgsForParent(category, args);"-  | otherwise =  onlyCodes $ allCats ++ ["  return false;"] where-    params = map (\p -> (vpParam p,vpVariance p)) $ getCategoryParams t-    myType = (getCategoryName t,map (singleType . JustParamName False . fst) params)-    refines = map (\r -> (tiName r,pValues $ tiParams r)) $ map vrType $ getCategoryRefines t-    allCats = concat $ map singleCat (myType:refines)-    singleCat (t2,ps) = [-        "  if (&category == &" ++ categoryGetter t2 ++ "()) {",-        "    args = std::vector<S<const TypeInstance>>{" ++ expanded ++ "};",-        "    return true;",-        "  }"-      ]-      where-        expanded = intercalate ", " $ map expandLocalType ps+  | isInstanceInterface t = onlyCode $ "  return false;"+  | otherwise = onlyCodes $ [+      "  using CallType = void(" ++ className ++ "::*)(std::vector<S<const TypeInstance>>&)const;",+      "  static DispatchSingle<CallType> all_calls[] = {"+    ] ++ map dispatchKeyValue ((getCategoryName t):refines) ++ [+      "    DispatchSingle<CallType>(),",+      "  };",+      "  const DispatchSingle<CallType>* const call = DispatchSelect(&category, all_calls);",+      "  if (call) {",+      "    (this->*call->value)(args);",+      "    return true;",+      "  }",+      "  return false;"+    ] where+      className = typeName $ getCategoryName t+      refines = map (tiName . vrType) $ getCategoryRefines t+      dispatchKeyValue n = "    DispatchSingle<CallType>(&" ++ categoryGetter n +++                           "(), &" ++ className ++ "::Params_" ++ show n ++ "),"  -- Similar to Procedure.expandGeneralInstance but doesn't account for scope. expandLocalType :: GeneralInstance -> String@@ -881,7 +893,7 @@   onlyCodes [       "S<TypeValue> " ++ valueCreator (getCategoryName t) ++       "(S<" ++ typeName (getCategoryName t) ++ "> parent, " ++-      "const ParamTuple& params, const ValueTuple& args);"+      "const ValueTuple& args);"     ]  defineInternalValue :: AnyCategory c -> CompiledData [String]@@ -891,8 +903,8 @@ defineInternalValue2 className t =   onlyCodes [       "S<TypeValue> " ++ valueCreator (getCategoryName t) ++ "(S<" ++ typeName (getCategoryName t) ++ "> parent, " ++-      "const ParamTuple& params, const ValueTuple& args) {",-      "  return S_get(new " ++ className ++ "(parent, params, args));",+      "const ValueTuple& args) {",+      "  return S_get(new " ++ className ++ "(parent, args));",       "}"     ] 

@@ -76,19 +76,18 @@   tmPublic  <- foldM includeNewTypes defaultCategories [cs0,cs1]   tmPrivate <- foldM includeNewTypes tmPublic          [ps0,ps1]   tmTesting <- foldM includeNewTypes tmPrivate         [ts0,ts1]-  let nsPublic  = ns0 `Set.union` ns2-  let nsPrivate = ns1 `Set.union` nsPublic-  let nsTesting = nsPrivate   xxInterfaces <- fmap concat $ collectAllM $-    map (generateNativeInterface False) (onlyNativeInterfaces cs1) ++-    map (generateNativeInterface False) (onlyNativeInterfaces ps1) ++-    map (generateNativeInterface True)  (onlyNativeInterfaces ts1)-  xxPrivate <- fmap concat $ mapCompilerM (compilePrivate (tmPrivate,nsPrivate) (tmTesting,nsTesting)) xa+    map (generateNativeInterface False nsPublic)  (onlyNativeInterfaces cs1) +++    map (generateNativeInterface False nsPrivate) (onlyNativeInterfaces ps1) +++    map (generateNativeInterface True  nsPrivate) (onlyNativeInterfaces ts1)+  xxPrivate <- fmap concat $ mapCompilerM (compilePrivate tmPrivate tmTesting) xa   xxStreamlined <- fmap concat $ mapCompilerM (streamlined tmTesting) $ nub ss   xxVerbose <- fmap concat $ mapCompilerM (verbose tmTesting) $ nub ex   let allFiles = xxInterfaces ++ xxPrivate ++ xxStreamlined ++ xxVerbose   noDuplicateFiles $ map (\f -> (coFilename f,coNamespace f)) allFiles   return allFiles where+    nsPublic  = ns0 `Set.union` ns2+    nsPrivate = ns1 `Set.union` nsPublic     extensions = Set.fromList $ ex ++ ss     testingCats = Set.fromList $ map getCategoryName ts1     onlyNativeInterfaces = filter (not . (`Set.member` extensions) . getCategoryName) . filter (not . isValueConcrete)@@ -96,25 +95,25 @@     streamlined tm n = do       checkLocal localCats ([] :: [String]) n       (_,t) <- getConcreteCategory tm ([],n)-      generateStreamlinedExtension (n `Set.member` testingCats) t+      generateStreamlinedExtension (n `Set.member` testingCats) nsPrivate t     verbose tm n = do       checkLocal localCats ([] :: [String]) n       (_,t) <- getConcreteCategory tm ([],n)       generateVerboseExtension (n `Set.member` testingCats) t-    compilePrivate (tmPrivate,nsPrivate) (tmTesting,nsTesting) (PrivateSource ns3 testing cs2 ds) = do-      let (tm,ns) = if testing-                       then (tmTesting,nsTesting)-                       else (tmPrivate,nsPrivate)+    compilePrivate tmPrivate tmTesting (PrivateSource ns3 testing cs2 ds) = do+      let tm = if testing+                  then tmTesting+                  else tmPrivate       let cs = Set.fromList $ map getCategoryName $ if testing                                                        then cs2 ++ cs1 ++ ps1 ++ ts1                                                        else cs2 ++ cs1 ++ ps1       tm' <- includeNewTypes tm cs2-      let ctx = FileContext testing tm' (ns3 `Set.insert` ns) em+      let ctx = FileContext testing tm' (ns3 `Set.insert` nsPrivate) em       checkLocals ds $ Map.keysSet tm'       when testing $ checkTests ds (cs1 ++ ps1)       let dm = mapDefByName ds       checkDefined dm Set.empty $ filter isValueConcrete cs2-      xxInterfaces <- fmap concat $ mapCompilerM (generateNativeInterface testing) (filter (not . isValueConcrete) cs2)+      xxInterfaces <- fmap concat $ mapCompilerM (generateNativeInterface testing nsPrivate) (filter (not . isValueConcrete) cs2)       xxConcrete   <- fmap concat $ mapCompilerM (generateConcrete cs ctx) ds       return $ xxInterfaces ++ xxConcrete     generateConcrete cs (FileContext testing tm ns em2) d = do

@@ -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.@@ -33,6 +33,7 @@   functionName,   headerFilename,   headerStreamlined,+  hiddenVariableName,   initializerName,   intersectGetter,   mainFilename,@@ -104,6 +105,9 @@ variableName :: VariableName -> String variableName v = "Var_" ++ show v +hiddenVariableName :: VariableName -> String+hiddenVariableName v = "Internal_" ++ show v+ initializerName :: VariableName -> String initializerName v = "Init_" ++ show v @@ -146,10 +150,10 @@ callName :: FunctionName -> String callName f = "Call_" ++ show f -functionDebugName :: ScopedFunction c -> String-functionDebugName f-  | sfScope f == CategoryScope = show (sfType f) ++ ":" ++ show (sfName f)-  | otherwise                  = show (sfType f) ++ "." ++ show (sfName f)+functionDebugName :: CategoryName -> ScopedFunction c -> String+functionDebugName t f+  | sfScope f == CategoryScope = show t ++ ":" ++ show (sfName f)+  | otherwise                  = show t ++ "." ++ show (sfName f)  functionName :: ScopedFunction c -> String functionName f = "Function_" ++ show (sfType f) ++ "_" ++ show (sfName f)

@@ -139,7 +139,7 @@     returnType = "ReturnTuple"     setProcedureTrace       | any isNoTrace pragmas = return []-      | otherwise             = return [startFunctionTracing ff]+      | otherwise             = return [startFunctionTracing (scName ctx) ff]     setCreationTrace       | not $ any isTraceCreation pragmas = return []       | s /= ValueScope =@@ -158,7 +158,7 @@       | isUnnamedReturns rs2 = []       | otherwise = map (\(i,(t2,n2)) -> nameReturn i (pvType t2) n2) (zip ([0..] :: [Int]) $ zip (pValues rs1) (pValues $ nrNames rs2))     nameReturn i t2 n2-      | isPrimType t2 = variableProxyType t2 ++ " " ++ variableName (ovName n2) ++ ";"+      | isPrimitiveType t2 = variableProxyType t2 ++ " " ++ variableName (ovName n2) ++ ";"       | otherwise =         variableProxyType t2 ++ " " ++ variableName (ovName n2) ++         " = " ++ writeStoredVariable t2 (UnwrappedSingle $ "returns.At(" ++ show i ++ ")") ++ ";"@@ -298,7 +298,7 @@         self <- autoSelfType         t1' <- lift $ replaceSelfValueType self t1         -- TODO: Call csAddRequired for t1'. (Maybe needs a helper function.)-        lift $ collectAllM_ [validateGeneralInstance r fa (vtType t1'),+        lift $ collectAllM_ [validateGeneralInstance r (Map.keysSet fa) (vtType t1'),                              checkValueAssignment r fa t2 t1']         csAddVariable (UsedVariable c2 n) (VariableValue c2 LocalScope t1' VariableDefault)         csWrite [variableStoredType t1' ++ " " ++ variableName n ++ ";"]@@ -369,7 +369,7 @@                          CompilerContext c m [String] a) =>   VoidExpression c -> CompilerState a m () compileVoidExpression (Conditional ie) = compileIfElifElse ie-compileVoidExpression (Loop l) = compileWhileLoop l+compileVoidExpression (Loop l) = compileIteratedLoop l compileVoidExpression (WithScope s) = compileScopedBlock s compileVoidExpression (LineComment s) = csWrite $ map ("// " ++) $ lines s compileVoidExpression (Unconditional p) = do@@ -407,10 +407,9 @@       return $ ctx:cs compileIfElifElse _ = undefined -compileWhileLoop :: (Ord c, Show c, CollectErrorsM m,-                     CompilerContext c m [String] a) =>-  WhileLoop c -> CompilerState a m ()-compileWhileLoop (WhileLoop c e p u) = do+compileIteratedLoop :: (Ord c, Show c, CollectErrorsM m, CompilerContext c m [String] a) =>+  IteratedLoop c -> CompilerState a m ()+compileIteratedLoop (WhileLoop c e p u) = do   ctx0 <- getCleanContext   (e',ctx1) <- compileCondition ctx0 c e   csInheritReturns [ctx1]@@ -429,6 +428,38 @@   getAndIndentOutput ctx >>= csWrite   csWrite $ ["{"] ++ u' ++ ["}"]   csWrite ["}"]+compileIteratedLoop (TraverseLoop c1 e c2 a (Procedure c3 ss)) = "In compilation of traverse at " ++ formatFullContext c1 ??> do+  (Positional ts,e') <- compileExpression e+  checkContainer ts+  r <- csResolver+  fa <- csAllFilters+  let [t] = ts+  let autoParam = ParamName "#auto"+  let autoType  = singleType $ JustParamName False autoParam+  (Positional [t2]) <- lift $ guessParams r fa (Positional [orderOptionalValue autoType])+                                               (Positional [autoParam])+                                               (Positional [InferredInstance c1])+                                               (Positional [t])+  let currVar = hiddenVariableName $ VariableName "traverse"+  let currType = orderOptionalValue $ fixTypeParams t2+  let currExpr    = BuiltinCall [] $ FunctionCall [] BuiltinRequire (Positional []) (Positional [RawExpression (Positional [currType]) (UnwrappedSingle currVar)])+  let currPresent = BuiltinCall [] $ FunctionCall [] BuiltinPresent (Positional []) (Positional [RawExpression (Positional [currType]) (UnwrappedSingle currVar)])+  let callNext = Expression c1 currExpr [ValueCall c1 $ FunctionCall c1 (FunctionName "next") (Positional []) (Positional [])]+  let callGet  = Expression c2 currExpr [ValueCall c2 $ FunctionCall c2 (FunctionName "get")  (Positional []) (Positional [])]+  (Positional [typeGet],exprNext) <- compileExpression callNext+  when (typeGet /= currType) $ compilerErrorM $ "Unexpected return type from next(): " ++ show typeGet ++ " (expected) " ++ show currType ++ " (actual)"+  let assnGet = Assignment c2 (Positional [a]) callGet+  csAddRequired $ categoriesFromTypes $ vtType currType+  compileStatement $ NoValueExpression [] $ WithScope $ ScopedBlock []+    (Procedure [] [RawCodeLine $ variableStoredType currType ++ " " ++ currVar ++ " = " ++ writeStoredVariable currType e' ++ ";"]) Nothing []+    (NoValueExpression [] $ Loop $ WhileLoop [] (Expression [] currPresent [])+      (Procedure c3 (assnGet:ss))+      (Just $ Procedure [] [RawCodeLine $ currVar ++ " = " ++ writeStoredVariable currType exprNext ++ ";"]))+    where+      checkContainer [_] = return ()+      checkContainer ts =+        compilerErrorM $ "Expected exactly one Order<?> value but got " +++                         intercalate ", " (map show ts)  compileScopedBlock :: (Ord c, Show c, CollectErrorsM m,                        CompilerContext c m [String] a) =>@@ -473,7 +504,7 @@       t' <- replaceSelfValueType self t       return (c,t',n)     createVariable r fa (c,t,n) = do-      lift $ validateGeneralInstance r fa (vtType t) <??+      lift $ validateGeneralInstance r (Map.keysSet fa) (vtType t) <??         "In creation of " ++ show n ++ " at " ++ formatFullContext c       csWrite [variableStoredType t ++ " " ++ variableName n ++ ";"]     showVariable (c,t,n) = do@@ -502,7 +533,7 @@  compileExpression :: (Ord c, Show c, CollectErrorsM m,                       CompilerContext c m [String] a) =>-  Expression c -> CompilerState a m (ExpressionType,ExprValue)+  Expression c -> CompilerState a m (ExpressionType,ExpressionValue) compileExpression = compile where   compile (Literal (StringLiteral _ l)) = do     csAddRequired (Set.fromList [BuiltinString])@@ -534,7 +565,7 @@     csAddRequired (Set.fromList [BuiltinBool])     return (Positional [boolRequiredValue],UnboxedPrimitive PrimBool "false")   compile (Literal (EmptyLiteral _)) = do-    return (Positional [emptyValue],UnwrappedSingle "Var_empty")+    return (Positional [emptyType],UnwrappedSingle "Var_empty")   compile (Expression _ s os) = do     foldl transform (compileExpressionStart s) os   compile (UnaryExpression c (FunctionOperator _ (FunctionSpec _ (CategoryFunction c2 cn) fn ps)) e) =@@ -577,7 +608,7 @@                                             UnboxedPrimitive PrimInt $ "~" ++ useAsUnboxed PrimInt e2)         | otherwise = compilerErrorM $ "Cannot use " ++ show t ++ " with unary ~ operator" ++                                              formatFullContextBrace c-  compile (InitializeValue c t ps es) = do+  compile (InitializeValue c t es) = do     scope <- csCurrentScope     t' <- case scope of                CategoryScope -> case t of@@ -590,15 +621,14 @@                       Nothing -> return self     es' <- sequence $ map compileExpression $ pValues es     (ts,es'') <- lift $ getValues es'-    csCheckValueInit c t' (Positional ts) ps+    csCheckValueInit c t' (Positional ts)     params <- expandParams $ tiParams t'-    params2 <- expandParams2 $ ps     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 ++ ", " ++ params2 ++ ", " ++ es'' ++ ")")+            UnwrappedSingle $ valueCreator (tiName t') ++ "(" ++ typeInstance ++ ", " ++ es'' ++ ")")     where       getType _  True ValueScope _      = "parent"       getType t2 _    _          params = typeCreator (tiName t2) ++ "(" ++ params ++ ")"@@ -627,6 +657,7 @@               then isolateExpression e2 -- Ignore named-return assignments.               else compileExpression e2     bindInfix c e1' o e2'+  compile (RawExpression ts e) = return (ts,e)   isolateExpression e = do     ctx <- getCleanContext     (e',ctx') <- lift $ runStateT (compileExpression e) ctx@@ -719,7 +750,7 @@  compileExpressionStart :: (Ord c, Show c, CollectErrorsM m,                            CompilerContext c m [String] a) =>-  ExpressionStart c -> CompilerState a m (ExpressionType,ExprValue)+  ExpressionStart c -> CompilerState a m (ExpressionType,ExpressionValue) compileExpressionStart (NamedVariable (OutputValue c n)) = do   let var = UsedVariable c n   (VariableValue _ s t _) <- csGetVariable var@@ -745,7 +776,7 @@   t' <- lift $ replaceSelfInstance self (singleType t)   r <- csResolver   fa <- csAllFilters-  lift $ validateGeneralInstance r fa t' <?? "In function call at " ++ formatFullContext c+  lift $ validateGeneralInstanceForCall r fa t' <?? "In function call at " ++ formatFullContext c   f' <- csGetTypeFunction c (Just t') n   when (sfScope f' /= TypeScope) $ compilerErrorM $ "Function " ++ show n ++                                                     " cannot be used as a type function" ++@@ -796,8 +827,8 @@   [t1,t2] <- lift $ mapCompilerM (replaceSelfInstance self) ps'   r <- csResolver   fa <- csAllFilters-  lift $ validateGeneralInstance r fa t1-  lift $ validateGeneralInstance r fa t2+  lift $ validateGeneralInstance r (Map.keysSet fa) t1+  lift $ validateGeneralInstance r (Map.keysSet fa) t2   lift $ (checkValueAssignment r fa t0 (ValueType OptionalValue t1)) <??     "In argument to reduce call at " ++ formatFullContext c   -- TODO: If t1 -> t2 then just return e without a Reduce call.@@ -844,7 +875,7 @@   [t] <- lift $ mapCompilerM (replaceSelfInstance self) ps'   r <- csResolver   fa <- csAllFilters-  lift $ validateGeneralInstance r fa t+  lift $ validateGeneralInstance r (Map.keysSet fa) t   t' <- expandGeneralInstance t   csAddRequired $ Set.unions $ map categoriesFromTypes [t]   return $ (Positional [formattedRequiredValue],@@ -873,7 +904,7 @@ compileFunctionCall :: (Ord c, Show c, CollectErrorsM m,                         CompilerContext c m [String] a) =>   Maybe String -> ScopedFunction c -> FunctionCall c ->-  CompilerState a m (ExpressionType,ExprValue)+  CompilerState a m (ExpressionType,ExpressionValue) compileFunctionCall e f (FunctionCall c _ ps es) = message ??> do   r <- csResolver   fa <- csAllFilters@@ -952,6 +983,23 @@     toInstance p1 (AssignedInstance _ t) = return (p1,t)     toInstance p1 (InferredInstance _)   = return (p1,singleType $ JustInferredType p1) +guessParams :: (Ord c, Show c, CollectErrorsM m, TypeResolver r) =>+  r -> ParamFilters -> Positional ValueType -> Positional ParamName ->+  Positional (InstanceOrInferred c) -> Positional ValueType -> m (Positional GeneralInstance)+guessParams r fa args params ps ts = do+  args' <- processPairs (\t1 t2 -> return $ PatternMatch Covariant t1 t2) ts args+  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+  fmap Positional $ mapCompilerM (subPosition pa3) (pValues params) where+    subPosition pa2 p =+      case p `Map.lookup` pa2 of+           Just t  -> return t+           Nothing -> compilerErrorM $ "Something went wrong inferring " ++ show p+    toInstance p1 (AssignedInstance _ t) = return (p1,t)+    toInstance p1 (InferredInstance _)   = return (p1,singleType $ JustInferredType p1)+ compileMainProcedure :: (Ord c, Show c, CollectErrorsM m) =>   CategoryMap c -> ExprMap c -> Expression c -> m (CompiledData [String]) compileMainProcedure tm em e = do@@ -1083,7 +1131,7 @@   where  autoPositionalCleanup :: (CollectErrorsM m, CompilerContext c m [String] a) =>-  [c] -> ExprValue -> CompilerState a m ()+  [c] -> ExpressionValue -> CompilerState a m () autoPositionalCleanup c e = do   named <- csIsNamedReturns   (CleanupBlock ss _ _ req) <- csGetCleanup JumpReturn

@@ -80,6 +80,10 @@   }   deriving (Eq,Ord,Show) +getIdentifierCategory :: CategoryIdentifier -> CategoryName+getIdentifierCategory (CategoryIdentifier _ n _) = n+getIdentifierCategory (UnresolvedCategory n)     = n+ mergeObjectFiles :: ObjectFile -> ObjectFile -> ObjectFile mergeObjectFiles (CategoryObjectFile c rs1 fs1) (CategoryObjectFile _ rs2 fs2) =   CategoryObjectFile c (nub $ rs1 ++ rs2) (nub $ fs1 ++ fs2)

@@ -372,7 +372,6 @@         indent "]",         "}"       ]-  writeConfig CompileUnspecified = writeConfig (CompileIncremental [])   writeConfig _ = compilerErrorM "Invalid compile mode"  parseExprMacro :: TextParser (MacroName,Expression SourceContext)

@@ -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.@@ -62,6 +62,7 @@   kwSelf,   kwStrong,   kwTestcase,+  kwTraverse,   kwTrue,   kwType,   kwTypename,@@ -263,6 +264,9 @@ kwTestcase :: TextParser () kwTestcase = keyword "testcase" +kwTraverse :: TextParser ()+kwTraverse = keyword "traverse"+ kwTrue :: TextParser () kwTrue = keyword "true" @@ -337,6 +341,7 @@     kwScoped,     kwStrong,     kwTestcase,+    kwTraverse,     kwTrue,     kwType,     kwTypename,

@@ -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.@@ -25,15 +25,15 @@  import Base.CompilerError import Parser.Common+import Parser.Pragma (autoPragma) import Parser.Procedure ()-import Parser.TextParser+import Parser.TextParser hiding (hidden) import Parser.TypeCategory import Parser.TypeInstance () import Types.DefinedCategory import Types.Procedure import Types.TypeCategory import Types.TypeInstance-import Types.Variance   instance ParseFromSource (DefinedCategory SourceContext) where@@ -42,30 +42,23 @@     kwDefine     n <- sourceParser     sepAfter (string_ "{")+    pragmas <- sepBy singlePragma optionalSpace     (ds,rs) <- parseRefinesDefines-    (pi,fi) <- parseInternalParams <|> return ([],[])     (ms,ps,fs) <- parseMemberProcedureFunction n     sepAfter (string_ "}")-    return $ DefinedCategory [c] n pi ds rs fi ms ps fs+    return $ DefinedCategory [c] n pragmas ds rs ms ps fs     where       parseRefinesDefines = fmap merge2 $ sepBy refineOrDefine optionalSpace+      singlePragma = readOnly <|> hidden+      readOnly = autoPragma "ReadOnly" $ Right parseAt where+        parseAt c = do+          vs <- labeled "variable names" $ sepBy sourceParser (sepAfter $ string ",")+          return $ MembersReadOnly [c] vs+      hidden = autoPragma "Hidden" $ Right parseAt where+        parseAt c = do+          vs <- labeled "variable names" $ sepBy sourceParser (sepAfter $ string ",")+          return $ MembersHidden [c] vs       refineOrDefine = labeled "refine or define" $ put12 singleRefine <|> put22 singleDefine-      parseInternalParams = labeled "internal params" $ do-        kwTypes-        pi <- between (sepAfter $ string_ "<")-                      (sepAfter $ string_ ">")-                      (sepBy singleParam (sepAfter $ string_ ","))-        fi <- parseInternalFilters-        return (pi,fi)-      parseInternalFilters = do-        try $ sepAfter (string_ "{")-        fi <- parseFilters-        sepAfter (string_ "}")-        return fi-      singleParam = labeled "param declaration" $ do-        c <- getSourceContext-        n <- sourceParser-        return $ ValueParam [c] n Invariant  instance ParseFromSource (DefinedMember SourceContext) where   sourceParser = labeled "defined member" $ do

@@ -225,18 +225,30 @@         p <- between (sepAfter $ string_ "{") (sepAfter $ string_ "}") sourceParser         return $ ElseStatement [c] p -instance ParseFromSource (WhileLoop SourceContext) where-  sourceParser = labeled "while" $ do-    c <- getSourceContext-    kwWhile-    i <- between (sepAfter $ string_ "(") (sepAfter $ string_ ")") sourceParser-    p <- between (sepAfter $ string_ "{") (sepAfter $ string_ "}") sourceParser-    u <- fmap Just parseUpdate <|> return Nothing-    return $ WhileLoop [c] i p u-    where-      parseUpdate = do-        kwUpdate-        between (sepAfter $ string_ "{") (sepAfter $ string_ "}") sourceParser+instance ParseFromSource (IteratedLoop SourceContext) where+  sourceParser = while <|> trav where+    while = labeled "while" $ do+      c <- getSourceContext+      kwWhile+      i <- between (sepAfter $ string_ "(") (sepAfter $ string_ ")") sourceParser+      p <- between (sepAfter $ string_ "{") (sepAfter $ string_ "}") sourceParser+      u <- fmap Just parseUpdate <|> return Nothing+      return $ WhileLoop [c] i p u+      where+        parseUpdate = do+          kwUpdate+          between (sepAfter $ string_ "{") (sepAfter $ string_ "}") sourceParser+    trav = labeled "traverse" $ do+      c1 <- getSourceContext+      kwTraverse+      sepAfter_ $ string "("+      e <- sourceParser+      sepAfter_ $ string "->"+      c2 <- getSourceContext+      a <- sourceParser+      sepAfter_ $ string ")"+      p <- between (sepAfter $ string_ "{") (sepAfter $ string_ "}") sourceParser+      return $ TraverseLoop [c1] e [c2] a p  instance ParseFromSource (ScopedBlock SourceContext) where   sourceParser = scoped <|> justCleanup where@@ -417,19 +429,9 @@           t2 <- (paramSelf >> return Nothing) <|> fmap Just sourceParser           sepAfter (labeled "@value initializer" $ string_ "{")           return t2-        withParams c t <|> withoutParams c t-      withParams c t = do-        kwTypes-        ps <- between (sepAfter $ string_ "<")-                      (sepAfter $ string_ ">")-                      (sepBy sourceParser (sepAfter $ string_ ","))-        as <- (sepAfter (string_ ",") >> sepBy sourceParser (sepAfter $ string_ ",")) <|> return []-        sepAfter (string_ "}")-        return $ InitializeValue [c] t (Positional ps) (Positional as)-      withoutParams c t = do         as <- sepBy sourceParser (sepAfter $ string_ ",")         sepAfter (string_ "}")-        return $ InitializeValue [c] t (Positional []) (Positional as)+        return $ InitializeValue [c] t (Positional as)  instance ParseFromSource (FunctionQualifier SourceContext) where   -- TODO: This is probably better done iteratively.

@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019 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.@@ -46,20 +46,19 @@       n <- sourceParser       ps <- parseCategoryParams       open-      (rs,vs) <- parseRefinesFilters+      rs <- parseCategoryRefines       fs <- flip sepBy optionalSpace $ parseScopedFunction (return ValueScope) (return n)       close-      return $ ValueInterface [c] NoNamespace n ps rs vs fs+      return $ ValueInterface [c] NoNamespace n ps rs fs     parseInstance = labeled "type interface" $ do       c <- getSourceContext       try $ kwType >> kwInterface       n <- sourceParser       ps <- parseCategoryParams       open-      vs <- parseFilters       fs <- flip sepBy optionalSpace $ parseScopedFunction (return TypeScope) (return n)       close-      return $ InstanceInterface [c] NoNamespace n ps vs fs+      return $ InstanceInterface [c] NoNamespace n ps fs     parseConcrete = labeled "concrete type" $ do       c <- getSourceContext       kwConcrete@@ -139,11 +138,6 @@  parseFilters :: TextParser [ParamFilter SourceContext] parseFilters = sepBy singleFilter optionalSpace--parseRefinesFilters :: TextParser ([ValueRefine SourceContext],[ParamFilter SourceContext])-parseRefinesFilters = parsed >>= return . merge2 where-  parsed = sepBy anyType optionalSpace-  anyType = labeled "refine or param filter" $ put12 singleRefine <|> put22 singleFilter  parseRefinesDefinesFilters ::   TextParser ([ValueRefine SourceContext],[ValueDefine SourceContext],[ParamFilter SourceContext])

@@ -31,11 +31,12 @@   forceParse,   loadFile,   parseFilterMap,-  parseTheTest,+  parseTestWithFilters,   readMulti,   readSingle,   readSingleWith,   runAllTests,+  showFilters,   showParams, ) where @@ -93,27 +94,35 @@       fs2 <- mapCompilerM (readSingle "(string)") fs       return (ParamName n,fs2) -parseTheTest :: ParseFromSource a => [(String,[String])] -> [String] -> TrackedErrors ([a],ParamFilters)-parseTheTest pa xs = do+parseTestWithFilters :: ParseFromSource a => [(String,[String])] -> [String] -> TrackedErrors ([a],ParamFilters)+parseTestWithFilters pa xs = do   ts <- mapCompilerM (readSingle "(string)") xs   pa2 <- parseFilterMap pa   return (ts,pa2) -showParams :: [(String,[String])] -> String-showParams pa = "[" ++ intercalate "," (concat $ map expand pa) ++ "]" where+parseTestWithParams :: ParseFromSource a => [String] -> [String] -> TrackedErrors ([a],Set.Set ParamName)+parseTestWithParams ps xs = do+  ts <- mapCompilerM (readSingle "(string)") xs+  return (ts,Set.fromList $ map ParamName ps)++showFilters :: [(String,[String])] -> String+showFilters pa = "[" ++ intercalate "," (concat $ map expand pa) ++ "]" where   expand (n,ps) = map (\p -> n ++ " " ++ p) ps -checkTypeSuccess :: TypeResolver r => r -> [(String,[String])] -> String -> TrackedErrors ()+showParams :: [String] -> String+showParams ps = "[" ++ intercalate "," ps ++ "]"++checkTypeSuccess :: TypeResolver r => r -> [String] -> String -> TrackedErrors () checkTypeSuccess r pa x = do-  ([t],pa2) <- parseTheTest pa [x]+  ([t],pa2) <- parseTestWithParams pa [x]   check $ validateGeneralInstance r pa2 t   where     prefix = x ++ " " ++ showParams pa     check x2 = x2 <!! prefix ++ ":" -checkTypeFail :: TypeResolver r => r -> [(String,[String])] -> String -> TrackedErrors ()+checkTypeFail :: TypeResolver r => r -> [String] -> String -> TrackedErrors () checkTypeFail r pa x = do-  ([t],pa2) <- parseTheTest pa [x]+  ([t],pa2) <- parseTestWithParams pa [x]   check $ validateGeneralInstance r pa2 t   where     prefix = x ++ " " ++ showParams pa@@ -122,17 +131,17 @@       | isCompilerError c = return ()       | otherwise = compilerErrorM $ prefix ++ ": Expected failure\n" -checkDefinesSuccess :: TypeResolver r => r -> [(String,[String])] -> String -> TrackedErrors ()+checkDefinesSuccess :: TypeResolver r => r -> [String] -> String -> TrackedErrors () checkDefinesSuccess r pa x = do-  ([t],pa2) <- parseTheTest pa [x]+  ([t],pa2) <- parseTestWithParams pa [x]   check $ validateDefinesInstance r pa2 t   where     prefix = x ++ " " ++ showParams pa     check x2 = x2 <!! prefix ++ ":" -checkDefinesFail :: TypeResolver r => r -> [(String,[String])] -> String -> TrackedErrors ()+checkDefinesFail :: TypeResolver r => r -> [String] -> String -> TrackedErrors () checkDefinesFail r pa x = do-  ([t],pa2) <- parseTheTest pa [x]+  ([t],pa2) <- parseTestWithParams pa [x]   check $ validateDefinesInstance r pa2 t   where     prefix = x ++ " " ++ showParams pa

@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019 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.@@ -31,9 +31,7 @@ tests :: [IO (TrackedErrors ())] tests = [     checkParseSuccess ("testfiles" </> "definitions.0rx"),-    checkParseSuccess ("testfiles" </> "internal_inheritance.0rx"),-    checkParseSuccess ("testfiles" </> "internal_params.0rx"),-    checkParseSuccess ("testfiles" </> "internal_filters.0rx")+    checkParseSuccess ("testfiles" </> "internal_inheritance.0rx")   ]  checkParseSuccess :: String -> IO (TrackedErrors ())@@ -55,4 +53,4 @@   check c     | isCompilerError c = return ()     | otherwise = compilerErrorM $ "Parse " ++ f ++ ": Expected failure but got\n" ++-                                 show (getCompilerSuccess c) ++ "\n"+                                   show (getCompilerSuccess c) ++ "\n"

@@ -353,7 +353,7 @@       ]     }, -    checkWriteFail "compile mode" $ ExecuteTests { etInclude = [] },+    checkWriteFail "compile mode" $ ExecuteTests { etInclude = [], etCallLog = Nothing },     checkWriteFail "compile mode" $ CompileRecompile,     checkWriteFail "compile mode" $ CompileRecompileRecursive,     checkWriteFail "compile mode" $ CreateTemplates,

@@ -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.@@ -65,13 +65,13 @@     checkShortParseSuccess "@type interface Type {}",     checkShortParseFail "@type interface Type { refines T }",     checkShortParseFail "@type interface Type { defines T }",-    checkShortParseSuccess "@type interface Type<#x> { #x allows T }",+    checkShortParseFail "@type interface Type<#x> { #x allows T }",      checkShortParseSuccess "@value interface Type<#x> {}",     checkShortParseSuccess "@value interface Type {}",     checkShortParseSuccess "@value interface Type { refines T }",     checkShortParseFail "@value interface Type { defines T }",-    checkShortParseSuccess "@value interface Type<#x> { #x allows T }",+    checkShortParseFail "@value interface Type<#x> { #x allows T }",      checkShortParseSuccess "@value interface Type { call () -> (#self) }",     checkShortParseFail "@value interface Type<#self> {}",@@ -98,23 +98,23 @@     checkOperationSuccess       ("testfiles" </> "concrete_refines_value.0rx")       (checkConnectedTypes $ Map.fromList [-          (CategoryName "Parent2",InstanceInterface [] NoNamespace (CategoryName "Parent2") [] [] [])+          (CategoryName "Parent2",InstanceInterface [] NoNamespace (CategoryName "Parent2") [] [])         ]),     checkOperationFail       ("testfiles" </> "concrete_refines_value.0rx")       (checkConnectedTypes $ Map.fromList [-          (CategoryName "Parent",InstanceInterface [] NoNamespace (CategoryName "Parent") [] [] [])+          (CategoryName "Parent",InstanceInterface [] NoNamespace (CategoryName "Parent") [] [])         ]),      checkOperationSuccess       ("testfiles" </> "partial.0rx")       (checkConnectedTypes $ Map.fromList [-          (CategoryName "Parent",ValueInterface [] NoNamespace (CategoryName "Parent") [] [] [] [])+          (CategoryName "Parent",ValueInterface [] NoNamespace (CategoryName "Parent") [] [] [])         ]),     checkOperationFail       ("testfiles" </> "partial.0rx")       (checkConnectedTypes $ Map.fromList [-          (CategoryName "Parent",InstanceInterface [] NoNamespace (CategoryName "Parent") [] [] [])+          (CategoryName "Parent",InstanceInterface [] NoNamespace (CategoryName "Parent") [] [])         ]),     checkOperationFail       ("testfiles" </> "partial.0rx")@@ -165,7 +165,7 @@       ("testfiles" </> "flatten.0rx")       (\ts -> do         existing  <- return $ Map.fromList [-            (CategoryName "Parent2",InstanceInterface [] NoNamespace (CategoryName "Parent2") [] [] [])+            (CategoryName "Parent2",InstanceInterface [] NoNamespace (CategoryName "Parent2") [] [])           ]         ts2 <- topoSortCategories existing ts         flattenAllConnections existing ts2),@@ -173,7 +173,7 @@       ("testfiles" </> "flatten.0rx")       (\ts -> do         existing  <- return $ Map.fromList [-            (CategoryName "Parent",InstanceInterface [] NoNamespace (CategoryName "Parent") [] [] [])+            (CategoryName "Parent",InstanceInterface [] NoNamespace (CategoryName "Parent") [] [])           ]         topoSortCategories existing ts), @@ -184,11 +184,11 @@             (CategoryName "Parent",             ValueInterface [] NoNamespace (CategoryName "Parent") []                            [ValueRefine [] $ TypeInstance (CategoryName "Object1") (Positional []),-                           ValueRefine [] $ TypeInstance (CategoryName "Object2") (Positional [])] [] []),+                           ValueRefine [] $ TypeInstance (CategoryName "Object2") (Positional [])] []),             -- NOTE: Object1 deliberately excluded here so that we catch             -- unnecessary recursion in existing categories.             (CategoryName "Object2",-            ValueInterface [] NoNamespace (CategoryName "Object2") [] [] [] [])+            ValueInterface [] NoNamespace (CategoryName "Object2") [] [] [])           ]         ts2 <- topoSortCategories existing ts         ts3 <- flattenAllConnections existing ts2@@ -214,12 +214,12 @@     checkOperationSuccess       ("testfiles" </> "concrete_refines_value.0rx")       (checkParamVariances $ Map.fromList [-          (CategoryName "Parent2",InstanceInterface [] NoNamespace (CategoryName "Parent2") [] [] [])+          (CategoryName "Parent2",InstanceInterface [] NoNamespace (CategoryName "Parent2") [] [])         ]),     checkOperationFail       ("testfiles" </> "concrete_refines_value.0rx")       (checkParamVariances $ Map.fromList [-          (CategoryName "Parent",InstanceInterface [] NoNamespace (CategoryName "Parent") [] [] [])+          (CategoryName "Parent",InstanceInterface [] NoNamespace (CategoryName "Parent") [] [])         ]),      checkOperationSuccess@@ -228,7 +228,7 @@           (CategoryName "Parent",            ValueInterface [] NoNamespace (CategoryName "Parent")                           [ValueParam [] (ParamName "#w") Contravariant,-                           ValueParam [] (ParamName "#z") Covariant] [] [] [])+                           ValueParam [] (ParamName "#z") Covariant] [] [])       ]),     checkOperationFail       ("testfiles" </> "partial_params.0rx")@@ -236,7 +236,7 @@           (CategoryName "Parent",            ValueInterface [] NoNamespace (CategoryName "Parent")                           [ValueParam [] (ParamName "#w") Invariant,-                           ValueParam [] (ParamName "#z") Covariant] [] [] [])+                           ValueParam [] (ParamName "#z") Covariant] [] [])       ]),     checkOperationFail       ("testfiles" </> "partial_params.0rx")@@ -244,7 +244,7 @@           (CategoryName "Parent",            ValueInterface [] NoNamespace (CategoryName "Parent")                           [ValueParam [] (ParamName "#w") Contravariant,-                           ValueParam [] (ParamName "#z") Invariant] [] [] [])+                           ValueParam [] (ParamName "#z") Invariant] [] [])       ]),      checkOperationSuccess@@ -358,56 +358,6 @@             []           ]), -    checkOperationSuccess-      ("testfiles" </> "value_interface.0rx")-      (\ts -> do-        rs <- getTypeFilters ts "Type<#a,#b,#c,#d,#e,#f>"-        checkPaired containsExactly rs [-            ["allows Parent"],-            ["requires Type2<#a>"],-            ["defines Equals<#c>"],-            [],-            [],-            []-          ]),-    checkOperationSuccess-      ("testfiles" </> "value_interface.0rx")-      (\ts -> do-        rs <- getTypeFilters ts "Type<Type<#t>,#b,Type3<#x>,#d,#e,#f>"-        checkPaired containsExactly rs [-            ["allows Parent"],-            ["requires Type2<Type<#t>>"],-            ["defines Equals<Type3<#x>>"],-            [],-            [],-            []-          ]),--    checkOperationSuccess-      ("testfiles" </> "type_interface.0rx")-      (\ts -> do-        rs <- getTypeDefinesFilters ts "Type<#a,#b,#c,#d,#e,#f>"-        checkPaired containsExactly rs [-            ["allows Parent"],-            ["requires Type2<#a>"],-            ["defines Equals<#c>"],-            [],-            [],-            []-          ]),-    checkOperationSuccess-      ("testfiles" </> "type_interface.0rx")-      (\ts -> do-        rs <- getTypeDefinesFilters ts "Type<Type<#t>,#b,Type3<#x>,#d,#e,#f>"-        checkPaired containsExactly rs [-            ["allows Parent"],-            ["requires Type2<Type<#t>>"],-            ["defines Equals<Type3<#x>>"],-            [],-            [],-            []-          ]),-     -- TODO: Clean these tests up.     checkOperationSuccess       ("testfiles" </> "flatten.0rx")@@ -481,7 +431,7 @@         ta <- flattenAllConnections Map.empty ts2 >>= declareAllTypes Map.empty         let r = CategoryResolver ta         checkTypeSuccess r [] "Value0<Value1,Value2>"),-    checkOperationFail+    checkOperationSuccess       ("testfiles" </> "filters.0rx")       (\ts -> do         ts2 <- topoSortCategories Map.empty ts@@ -495,14 +445,14 @@         ta <- flattenAllConnections Map.empty ts2 >>= declareAllTypes Map.empty         let r = CategoryResolver ta         checkTypeSuccess r [] "Value0<Value3,Value2>"),-    checkOperationFail+    checkOperationSuccess       ("testfiles" </> "filters.0rx")       (\ts -> do         ts2 <- topoSortCategories Map.empty ts         ta <- flattenAllConnections Map.empty ts2 >>= declareAllTypes Map.empty         let r = CategoryResolver ta         checkTypeSuccess r-          [("#x",[]),("#y",[])]+          ["#x","#y"]           "Value0<#x,#y>"),     checkOperationSuccess       ("testfiles" </> "filters.0rx")@@ -511,8 +461,7 @@         ta <- flattenAllConnections Map.empty ts2 >>= declareAllTypes Map.empty         let r = CategoryResolver ta         checkTypeSuccess r-          [("#x",["allows #y","requires Function<#x,#y>"]),-           ("#y",["requires #x","defines Equals<#y>"])]+          ["#x","#y"]           "Value0<#x,#y>"),     checkOperationSuccess       ("testfiles" </> "filters.0rx")@@ -521,74 +470,19 @@         ta <- flattenAllConnections Map.empty ts2 >>= declareAllTypes Map.empty         let r = CategoryResolver ta         checkTypeSuccess r-          [("#x",["allows Value2","requires Function<#x,Value2>"])]+          ["#x","#y"]           "Value0<#x,Value2>"),-    checkOperationFail+    checkOperationSuccess       ("testfiles" </> "filters.0rx")       (\ts -> do         ts2 <- topoSortCategories Map.empty ts         ta <- flattenAllConnections Map.empty ts2 >>= declareAllTypes Map.empty         let r = CategoryResolver ta         checkTypeSuccess r-          [("#x",["allows Value2","requires Function<#x,Value2>"]),-           ("#y",["requires #x","defines Equals<#y>"])]+          ["#x","#y"]           "Value0<#x,#y>"),      checkOperationSuccess-      ("testfiles" </> "concrete_instances.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationFail-      ("testfiles" </> "concrete_missing_define.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationFail-      ("testfiles" </> "concrete_missing_refine.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationSuccess-      ("testfiles" </> "value_instances.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationFail-      ("testfiles" </> "value_missing_define.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationFail-      ("testfiles" </> "value_missing_refine.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationSuccess-      ("testfiles" </> "type_instances.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationFail-      ("testfiles" </> "type_missing_define.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationFail-      ("testfiles" </> "type_missing_refine.0rx")-      (\ts -> do-        ts2 <- topoSortCategories defaultCategories ts-        ts3 <- flattenAllConnections defaultCategories ts2-        checkCategoryInstances defaultCategories ts3),-    checkOperationSuccess       ("testfiles" </> "requires_concrete.0rx")       (\ts -> do         ts2 <- topoSortCategories defaultCategories ts@@ -641,7 +535,7 @@       ("testfiles" </> "flatten.0rx")       (\ts -> do         let tm0 = Map.fromList [-                    (CategoryName "Parent2",InstanceInterface [] NoNamespace (CategoryName "Parent2") [] [] [])+                    (CategoryName "Parent2",InstanceInterface [] NoNamespace (CategoryName "Parent2") [] [])                   ]         tm <- includeNewTypes tm0 ts         rs <- getRefines tm "Child"@@ -662,30 +556,15 @@       ("testfiles" </> "function_bad_filter_param.0rx")       (\ts -> checkCategoryInstances defaultCategories ts),     checkOperationFail-      ("testfiles" </> "function_bad_allows_type.0rx")-      (\ts -> checkCategoryInstances defaultCategories ts),-    checkOperationFail       ("testfiles" </> "function_bad_allows_variance.0rx")       (\ts -> checkCategoryInstances defaultCategories ts),     checkOperationFail-      ("testfiles" </> "function_bad_requires_type.0rx")-      (\ts -> checkCategoryInstances defaultCategories ts),-    checkOperationFail       ("testfiles" </> "function_bad_requires_variance.0rx")       (\ts -> checkCategoryInstances defaultCategories ts),     checkOperationFail-      ("testfiles" </> "function_bad_defines_type.0rx")-      (\ts -> checkCategoryInstances defaultCategories ts),-    checkOperationFail       ("testfiles" </> "function_bad_defines_variance.0rx")       (\ts -> checkCategoryInstances defaultCategories ts),     checkOperationFail-      ("testfiles" </> "function_bad_arg.0rx")-      (\ts -> checkCategoryInstances defaultCategories ts),-    checkOperationFail-      ("testfiles" </> "function_bad_return.0rx")-      (\ts -> checkCategoryInstances defaultCategories ts),-    checkOperationFail       ("testfiles" </> "weak_arg.0rx")       (\ts -> checkCategoryInstances defaultCategories ts),     checkOperationFail@@ -695,13 +574,13 @@     checkOperationSuccess       ("testfiles" </> "function_filters_satisfied.0rx")       (\ts -> checkCategoryInstances defaultCategories ts),-    checkOperationFail+    checkOperationSuccess       ("testfiles" </> "function_requires_missed.0rx")       (\ts -> checkCategoryInstances defaultCategories ts),-    checkOperationFail+    checkOperationSuccess       ("testfiles" </> "function_allows_missed.0rx")       (\ts -> checkCategoryInstances defaultCategories ts),-    checkOperationFail+    checkOperationSuccess       ("testfiles" </> "function_defines_missed.0rx")       (\ts -> checkCategoryInstances defaultCategories ts), @@ -724,23 +603,23 @@     checkOperationSuccess       ("testfiles" </> "valid_filter_variance.0rx")       (\ts -> checkParamVariances defaultCategories ts),-    checkOperationFail-      ("testfiles" </> "bad_allows_variance_right.0rx")+    checkOperationSuccess+      ("testfiles" </> "allows_variance_right.0rx")       (\ts -> checkParamVariances defaultCategories ts),-    checkOperationFail-      ("testfiles" </> "bad_defines_variance_right.0rx")+    checkOperationSuccess+      ("testfiles" </> "defines_variance_right.0rx")       (\ts -> checkParamVariances defaultCategories ts),-    checkOperationFail-      ("testfiles" </> "bad_requires_variance_right.0rx")+    checkOperationSuccess+      ("testfiles" </> "requires_variance_right.0rx")       (\ts -> checkParamVariances defaultCategories ts),-    checkOperationFail-      ("testfiles" </> "bad_allows_variance_left.0rx")+    checkOperationSuccess+      ("testfiles" </> "allows_variance_left.0rx")       (\ts -> checkParamVariances defaultCategories ts),-    checkOperationFail-      ("testfiles" </> "bad_defines_variance_left.0rx")+    checkOperationSuccess+      ("testfiles" </> "defines_variance_left.0rx")       (\ts -> checkParamVariances defaultCategories ts),-    checkOperationFail-      ("testfiles" </> "bad_requires_variance_left.0rx")+    checkOperationSuccess+      ("testfiles" </> "requires_variance_left.0rx")       (\ts -> checkParamVariances defaultCategories ts),      checkOperationFail@@ -808,9 +687,6 @@     checkOperationSuccess       ("testfiles" </> "valid_self.0rx")       (includeNewTypes defaultCategories >=> const (return ())),-    checkOperationSuccess-      ("testfiles" </> "filtered_self.0rx")-      (includeNewTypes defaultCategories >=> const (return ())),     checkOperationFail       ("testfiles" </> "bad_merge_self.0rx")       (includeNewTypes defaultCategories >=> const (return ())),@@ -1008,6 +884,23 @@           [("#x","all")]),      checkOperationSuccess+      ("testfiles" </> "inference.0rx")+      (\ts -> do+        tm <- includeNewTypes defaultCategories ts+        checkInferenceSuccess tm+          [("#x",[])] ["#x"]+          [("Interface1<all>","Interface1<#x>")]+          [("#x","all")]),+    checkOperationSuccess+      ("testfiles" </> "inference.0rx")+      (\ts -> do+        tm <- includeNewTypes defaultCategories ts+        checkInferenceSuccess tm+          [("#x",[])] ["#x"]+          [("Interface2<any>","Interface2<#x>")]+          [("#x","any")]),++    checkOperationSuccess       ("testfiles" </> "delayed_merging.0rx")       (\ts -> do         tm <- includeNewTypes defaultCategories ts@@ -1206,7 +1099,7 @@  scrapeAllRefines :: [AnyCategory c] -> [(String, String)] scrapeAllRefines = map (show *** show) . concat . map scrapeSingle where-  scrapeSingle (ValueInterface _ _ n _ rs _ _) = map ((,) n . vrType) rs+  scrapeSingle (ValueInterface _ _ n _ rs _)    = map ((,) n . vrType) rs   scrapeSingle (ValueConcrete _ _ n _ rs _ _ _) = map ((,) n . vrType) rs   scrapeSingle _ = [] @@ -1291,7 +1184,7 @@ checkInferenceSuccess :: CategoryMap SourceContext -> [(String, [String])] ->   [String] -> [(String,String)] -> [(String,String)] -> TrackedErrors () checkInferenceSuccess tm pa is ts gs = checkInferenceCommon check tm pa is ts gs where-  prefix = show ts ++ " " ++ showParams pa+  prefix = show ts ++ " " ++ showFilters pa   check gs2 c     | isCompilerError c = compilerErrorM $ prefix ++ ":\n" ++ show (getCompilerWarnings c) ++ show (getCompilerError c)     | otherwise        = getCompilerSuccess c `containsExactly` gs2@@ -1299,7 +1192,7 @@ checkInferenceFail :: CategoryMap SourceContext -> [(String, [String])] ->   [String] -> [(String,String)] -> TrackedErrors () checkInferenceFail tm pa is ts = checkInferenceCommon check tm pa is ts [] where-  prefix = show ts ++ " " ++ showParams pa+  prefix = show ts ++ " " ++ showFilters pa   check _ c     | isCompilerError c = return ()     | otherwise = compilerErrorM $ prefix ++ ": Expected failure\n"

@@ -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.@@ -414,19 +414,19 @@       []       "Type4<Type0>",     return $ checkTypeSuccess Resolver-      [("#x",["allows Type0"])]+      ["#x"]       "Type4<[#x&Type0]>",     return $ checkTypeSuccess Resolver-      [("#x",["allows Type0"])]+      ["#x"]       "Type4<[#x|Type0]>",     return $ checkTypeSuccess Resolver-      [("#x",["allows Type0"])]+      ["#x"]       "Type4<[#x|Type3]>",     return $ checkTypeFail Resolver       []       "Type5<#x>",     return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "Type5<#x>",      checkConvertSuccess@@ -547,69 +547,41 @@       "optional Type3",      return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "#x",-    return $ checkTypeFail Resolver-      [("#x",[])]-      "Type1<#x>",-    return $ checkTypeFail Resolver-      [("#x",["requires Type3"])]-      "Type1<#x>",-    return $ checkTypeFail Resolver-      [("#x",["defines Instance0"])]+    return $ checkTypeSuccess Resolver+      ["#x"]       "Type1<#x>",-    return $ checkTypeFail Resolver+    return $ checkTypeSuccess Resolver       []       "Type1<all>",     return $ checkTypeSuccess Resolver-      [("#x",["requires Type3","defines Instance0"])]+      ["#x"]       "Type1<#x>",     return $ checkTypeSuccess Resolver       []       "Type1<Type3>",-    return $ checkTypeFail Resolver+    return $ checkTypeSuccess Resolver       []       "Type1<Type1<Type3>>",     return $ checkTypeSuccess Resolver       []       "Type2<Type0,Type0,Type0>",-    return $ checkTypeFail Resolver+    return $ checkTypeSuccess Resolver       []       "Type2<all,Type0,Type0>",-    return $ checkTypeFail Resolver+    return $ checkTypeSuccess Resolver       []       "Type2<any,Type0,Type0>",     return $ checkTypeSuccess Resolver       []       "Type4<any>",-    return $ checkTypeFail Resolver+    return $ checkTypeSuccess Resolver       []       "Type4<all>",      return $ checkTypeSuccess Resolver-      [("#x",["defines Instance1<Type0>",-             "defines Instance1<#x>",-             "defines Instance1<Type3>"])]-      "Type2<#x,#x,#x>",-    return $ checkTypeFail Resolver-      [("#x",["defines Instance1<#x>",-             "defines Instance1<Type3>"])]-      "Type2<#x,#x,#x>",-    return $ checkTypeFail Resolver-      [("#x",["defines Instance1<Type0>",-             "defines Instance1<Type3>"])]-      "Type2<#x,#x,#x>",-    return $ checkTypeSuccess Resolver-      [("#x",["defines Instance1<Type0>",-             "defines Instance1<#x>"])]-      "Type2<#x,#x,#x>",-    return $ checkTypeSuccess Resolver-      [("#x",["allows Type0", -- Type0 -> #x implies Type3 -> #x-             "defines Instance1<#x>"])]-      "Type2<#x,#x,#x>",-    return $ checkTypeFail Resolver-      [("#x",["allows Type3", -- Type3 -> #x doesn't imply Type0 -> #x-             "defines Instance1<#x>"])]+      ["#x"]       "Type2<#x,#x,#x>",      return $ checkTypeSuccess Resolver@@ -619,7 +591,7 @@       []       "Type5<#x>",     return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "Type5<#x>",      return $ checkTypeSuccess Resolver@@ -629,22 +601,22 @@       []       "[Type4<Type0>&Type1<Type3>]",     return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "[Type5<#x>|Type1<Type3>]",     return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "[Type5<#x>&Type1<Type3>]",     return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "[#x|Type1<Type3>]",     return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "[#x&Type1<Type3>]",     return $ checkTypeFail Resolver-      [("#x",[])]+      ["#x"]       "[Type4<Type0>|Instance0]",     return $ checkTypeFail Resolver-      [("#x",[])]+      ["#x"]       "[Type4<Type0>&Instance0]",      return $ checkTypeSuccess Resolver@@ -654,20 +626,17 @@       []       "[[Type4<Type0>|Type1<Type3>]&Type1<Type3>]",     return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "[[Type4<Type0>&#x]|Type1<Type3>]",     return $ checkTypeSuccess Resolver-      [("#x",[])]+      ["#x"]       "[[Type4<Type0>|#x]&Type1<Type3>]", -    return $ checkDefinesFail Resolver-      [("#x",[])]-      "Instance1<#x>",     return $ checkDefinesSuccess Resolver-      [("#x",["requires Type3"])]+      ["#x"]       "Instance1<#x>",     return $ checkDefinesFail Resolver-      [("#x",["defines Instance1<#x>"])]+      []       "Instance1<#x>",     return $ checkDefinesSuccess Resolver       []@@ -883,9 +852,9 @@  checkConvertSuccess :: [(String, [String])] -> String -> String -> IO (TrackedErrors ()) checkConvertSuccess pa x y = return checked where-  prefix = x ++ " -> " ++ y ++ " " ++ showParams pa+  prefix = x ++ " -> " ++ y ++ " " ++ showFilters pa   checked = do-    ([t1,t2],pa2) <- parseTheTest pa [x,y]+    ([t1,t2],pa2) <- parseTestWithFilters pa [x,y]     check $ checkValueAssignment Resolver pa2 t1 t2   check c     | isCompilerError c = compilerErrorM $ prefix ++ ":\n" ++ show (getCompilerError c)@@ -894,7 +863,7 @@ checkInferenceSuccess :: [(String, [String])] -> [String] -> String ->   String -> MergeTree (String,String,Variance) -> IO (TrackedErrors ()) checkInferenceSuccess pa is x y gs = checkInferenceCommon check pa is x y gs where-  prefix = x ++ " -> " ++ y ++ " " ++ showParams pa+  prefix = x ++ " -> " ++ y ++ " " ++ showFilters pa   check gs2 c     | isCompilerError c = compilerErrorM $ prefix ++ ":\n" ++ show (getCompilerError c)     | otherwise        = getCompilerSuccess c `checkEquals` gs2@@ -902,7 +871,7 @@ checkInferenceFail :: [(String, [String])] -> [String] -> String ->   String -> IO (TrackedErrors ()) checkInferenceFail pa is x y = checkInferenceCommon check pa is x y (mergeAll []) where-  prefix = x ++ " -> " ++ y ++ " " ++ showParams pa+  prefix = x ++ " -> " ++ y ++ " " ++ showFilters pa   check _ c     | isCompilerError c = return ()     | otherwise = compilerErrorM $ prefix ++ ": Expected failure\n"@@ -914,7 +883,7 @@ checkInferenceCommon check pa is x y gs = return $ checked <!! context where   context = "With params = " ++ show pa ++ ", pair = (" ++ show x ++ "," ++ show y ++ ")"   checked = do-    ([t1,t2],pa2) <- parseTheTest pa [x,y]+    ([t1,t2],pa2) <- parseTestWithFilters pa [x,y]     ia2 <- mapCompilerM readInferred is     gs' <- sequence $ fmap parseGuess gs     let iaMap = Map.fromList ia2@@ -939,9 +908,9 @@  checkConvertFail :: [(String, [String])] -> String -> String -> IO (TrackedErrors ()) checkConvertFail pa x y = return checked where-  prefix = x ++ " /> " ++ y ++ " " ++ showParams pa+  prefix = x ++ " /> " ++ y ++ " " ++ showFilters pa   checked = do-    ([t1,t2],pa2) <- parseTheTest pa [x,y]+    ([t1,t2],pa2) <- parseTestWithFilters pa [x,y]     check $ checkValueAssignment Resolver pa2 t1 t2   check :: TrackedErrors a -> TrackedErrors ()   check c

@@ -0,0 +1,5 @@+@value interface Interface {}++concrete Type<|#x> {+  #x allows Interface+}

@@ -0,0 +1,5 @@+@value interface Interface<|#x> {}++concrete Type<#x|> {+  #x allows Interface<#x>+}

@@ -1,5 +0,0 @@-@value interface Interface {}--concrete Type<|#x> {-  #x allows Interface-}

@@ -1,5 +0,0 @@-@value interface Interface<|#x> {}--concrete Type<#x|> {-  #x allows Interface<#x>-}

@@ -1,5 +0,0 @@-@type interface Interface {}--concrete Type<#x|> {-  #x defines Interface-}

@@ -1,5 +0,0 @@-@type interface Interface<|#x> {}--concrete Type<|#x> {-  #x defines Interface<#x>-}

@@ -1,5 +0,0 @@-@value interface Interface {}--concrete Type<#x|> {-  #x requires Interface-}

@@ -1,5 +0,0 @@-@value interface Interface<|#x> {}--concrete Type<|#x> {-  #x requires Interface<#x>-}

@@ -1,33 +0,0 @@-// Setup.--@type interface Type<#x|> {-  #x requires Value0-}--@value interface Value0 {}--@value interface Value1<|#y> {-  #y requires Value0-}--@value interface Value2 {-  refines Value0-}--@value interface Value3<|#z> {-  #z defines Type<Value0>-}---// Tests.--concrete Object0 {-  refines Value2 // -> Value0-  defines Type<Object0>-  refines Value1<Object0>-}--concrete Object1 {-  defines Type<Value0>-  refines Value3<Object1>-}

@@ -1,22 +0,0 @@-// Setup.--@type interface Type<#x|> {-  #x requires Value0-}--@value interface Value0 {}--@value interface Value1<|#y> {-  #y requires Value0-}--@value interface Value3<|#z> {-  #z defines Type<Value0>-}---// Tests.--concrete Object1 {-  refines Value3<Object1>-}

@@ -1,23 +0,0 @@-// Setup.--@type interface Type<#x|> {-  x requires Value0-}--@value interface Value0 {}--@value interface Value1<|#y> {-  y requires Value0-}--@value interface Value2 {-  refines Value0-}---// Tests.--concrete Object0 {-  defines Type<Object0>-  refines Value1<Object0>-}

@@ -0,0 +1,5 @@+@type interface Interface {}++concrete Type<#x|> {+  #x defines Interface+}

@@ -0,0 +1,5 @@+@type interface Interface<|#x> {}++concrete Type<|#x> {+  #x defines Interface<#x>+}

@@ -1,14 +0,0 @@-@value interface Foo {}--@type interface Bar {}--@value interface Base<|#x> {-  #x requires Foo-  #x defines Bar-}--concrete Value<#y|> {-  refines Base<#self>-  refines Foo-  defines Bar-}

@@ -1,9 +0,0 @@-@value interface Interface<#x> {-  #x requires Formatted-}--concrete Type<#x> {-  @type something<#y>-    #y allows Interface<#x>-  () -> ()-}

@@ -1,9 +0,0 @@-@value interface Type0 {}--@value interface Type1<#x> {-  #x requires Type0-}--concrete Type<x> {-  @value something (Type1<#x>) -> ()-}

@@ -1,9 +0,0 @@-@type interface Interface<#x> {-  #x requires Formatted-}--concrete Type<#x> {-  @type something<#y>-    #y defines Interface<#x>-  () -> ()-}

@@ -1,9 +0,0 @@-@type interface Interface<#x> {-  #x requires Formatted-}--concrete Type<#x> {-  @type something<#y>-    #y requires Interface<#x>-  () -> ()-}

@@ -1,9 +0,0 @@-@value interface Type0 {}--@value interface Type1<#x> {-  #x requires Type0-}--concrete Type<x> {-  @value something () -> (Type1<#x>)-}

@@ -6,11 +6,9 @@  concrete Type4<#x> {   #x requires Type2-  #x allows Type3   #x defines Type1    @type something<#y>     #y requires Type2-    #y allows Type3   () -> (Type4<#y>) }

@@ -1,7 +0,0 @@-define Type {-  types<#x,#y,#z> {-    #x requires Type1-    #y allows Type2-    #z defines Type3-  }-}

@@ -1,3 +0,0 @@-define Type {-  types<#x,#y,#z> {}-}

@@ -0,0 +1,5 @@+@value interface Interface {}++concrete Type<#x|> {+  #x requires Interface+}

@@ -0,0 +1,5 @@+@value interface Interface<|#x> {}++concrete Type<|#x> {+  #x requires Interface<#x>+}

@@ -1,33 +0,0 @@-// Setup.--@type interface Type<#x|> {-  #x requires Value0-}--@value interface Value0 {}--@value interface Value1<|#y> {-  #y requires Value0-}--@value interface Value2 {-  refines Value0-}--@value interface Value3<|#z> {-  #z defines Type<Value0>-}---// Tests.--@type interface Object0<#x> {-  #x requires Value2 // -> Value0-  #x defines Type<#x>-  #x requires Value1<#x>-}--@type interface Object1<#x> {-  #x defines Type<Value0>-  #x requires Value3<#x>-}

@@ -1,8 +1,4 @@ @type interface Type<#a,#b|#c,#d|#e,#f> {-  #a allows Parent-  #b requires Type2<#a>-  #c defines Equals<#c>-   create () -> (optional #x)    create2<#y>

@@ -1,22 +0,0 @@-// Setup.--@type interface Type<#x|> {-  #x requires Value0-}--@value interface Value0 {}--@value interface Value1<|#y> {-  #y requires Value0-}--@value interface Value3<|#z> {-  #z defines Type<Value0>-}---// Tests.--@type interface Object1<#x> {-  #x requires Value3<#x>-}

@@ -1,23 +0,0 @@-// Setup.--@type interface Type<#x|> {-  #x requires Value0-}--@value interface Value0 {}--@value interface Value1<|#y> {-  #y requires Value0-}--@value interface Value2 {-  refines Value0-}---// Tests.--@type interface Object0<#x> {-  #x defines Type<#x>-  #x requires Value1<#x>-}

@@ -1,33 +0,0 @@-// Setup.--@type interface Type<#x|> {-  #x requires Value0-}--@value interface Value0 {}--@value interface Value1<|#y> {-  #y requires Value0-}--@value interface Value2 {-  refines Value0-}--@value interface Value3<|#z> {-  #z defines Type<Value0>-}---// Tests.--@value interface Object0<#x> {-  #x requires Value2 // -> Value0-  #x defines Type<#x>-  #x requires Value1<#x>-}--@value interface Object1<#x> {-  #x defines Type<Value0>-  #x requires Value3<#x>-}