packages feed

zeolite-lang 0.14.0.0 → 0.15.0.0

raw patch · 117 files changed

+4949/−2361 lines, 117 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Base.CompilerError: mapErrorsM_ :: CollectErrorsM m => (a -> m b) -> [a] -> m ()
+ Base.CompilerError: emptyErrorM :: CollectErrorsM m => m a
+ Base.CompilerError: mapCompilerM :: CollectErrorsM m => (a -> m b) -> [a] -> m [b]
+ Base.CompilerError: mapCompilerM_ :: CollectErrorsM m => (a -> m b) -> [a] -> m ()
+ CompilerCxx.Code: startMainTracing :: String -> String
+ CompilerCxx.Naming: functionDebugName :: ScopedFunction c -> String
+ CompilerCxx.Procedure: FinalInlineFunction :: CxxFunctionType
+ CompilerCxx.Procedure: InlineFunction :: CxxFunctionType
+ CompilerCxx.Procedure: OutOfLineFunction :: String -> CxxFunctionType
+ CompilerCxx.Procedure: data CxxFunctionType
+ CompilerCxx.Procedure: instance GHC.Show.Show CompilerCxx.Procedure.CxxFunctionType
+ Types.Procedure: RawFailCall :: String -> Statement c
- Base.CompilerError: mapErrorsM :: CollectErrorsM m => (a -> m b) -> [a] -> m [b]
+ Base.CompilerError: mapErrorsM :: CollectErrorsM m => [String] -> m a
- CompilerCxx.Code: startFunctionTracing :: CategoryName -> FunctionName -> String
+ CompilerCxx.Code: startFunctionTracing :: ScopedFunction c -> String
- CompilerCxx.Procedure: compileExecutableProcedure :: (Ord c, Show c, CollectErrorsM m) => Maybe String -> ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> m (CompiledData [String])
+ CompilerCxx.Procedure: compileExecutableProcedure :: (Ord c, Show c, CollectErrorsM m) => CxxFunctionType -> ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> m (CompiledData [String])

Files

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