zeolite-lang 0.5.0.0 → 0.6.0.0

raw patch · 67 files changed

+2326/−2755 lines, 67 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +47/−0
• base/logging.cpp +15/−5
• base/logging.hpp +58/−4
• example/parser/.zeolite-module +9/−0
• example/parser/README.md +81/−0
• example/parser/parse-text.0rp +27/−0
• example/parser/parse-text.0rx +254/−0
• example/parser/parser-test.0rt +34/−0
• example/parser/parser.0rp +51/−0
• example/parser/parser.0rx +120/−0
• example/parser/test-data.0rp +11/−0
• example/parser/test-data.0rx +85/−0
• example/parser/test-data.txt +5/−0
• example/regex/README.md +0/−20
• example/regex/char-regex.0rp +0/−4
• example/regex/char-regex.0rx +0/−199
• example/regex/regex-demo.0rx +0/−92
• example/regex/regex-test.0rt +0/−1338
• example/regex/regex.0rp +0/−127
• example/regex/regex.0rx +0/−724
• lib/file/Category_RawFileReader.cpp +8/−1
• lib/file/Category_RawFileWriter.cpp +8/−1
• lib/file/tests.0rt +38/−11
• lib/util/.zeolite-module +9/−0
• lib/util/tests.0rt +140/−0
• lib/util/util.0rp +21/−0
• lib/util/util.0rx +62/−2
• src/Cli/CompileMetadata.hs +16/−1
• src/Cli/Compiler.hs +30/−20
• src/Cli/ParseCompileOptions.hs +2/−1
• src/Cli/ParseMetadata.hs +26/−8
• src/Cli/ProcessMetadata.hs +72/−42
• src/Cli/RunCompiler.hs +62/−26
• src/Compilation/CompileInfo.hs +2/−2
• src/Compilation/CompilerState.hs +15/−0
• src/Compilation/ProcedureContext.hs +73/−17
• src/Compilation/ScopeContext.hs +8/−6
• src/CompilerCxx/Category.hs +35/−23
• src/CompilerCxx/CategoryContext.hs +17/−13
• src/CompilerCxx/Code.hs +8/−0
• src/CompilerCxx/Procedure.hs +53/−20
• src/Config/LoadConfig.hs +37/−18
• src/Config/Paths.hs +1/−0
• src/Parser/Pragma.hs +28/−2
• src/Parser/Procedure.hs +11/−2
• src/Test/ParseMetadata.hs +46/−1
• src/Test/Pragma.hs +18/−1
• src/Test/Procedure.hs +5/−0
• src/Test/testfiles/module-config.txt +12/−0
• src/Types/Positional.hs +6/−4
• src/Types/Pragma.hs +28/−0
• src/Types/Procedure.hs +12/−0
• src/Types/TypeCategory.hs +11/−11
• src/Types/TypeInstance.hs +2/−1
• tests/.zeolite-module +15/−0
• tests/cli-tests.sh +43/−1
• tests/expr-lookup.0rp +26/−0
• tests/expr-lookup.0rt +205/−0
• tests/expr-lookup.0rx +34/−0
• tests/member-init.0rt +23/−0
• tests/tests-only/README.md +1/−1
• tests/tests-only2/.zeolite-module +6/−0
• tests/tests-only2/README.md +18/−0
• tests/tests-only2/private.0rx +23/−0
• tests/tests-only2/public.0rp +23/−0
• tests/tracing.0rt +177/−0
• zeolite-lang.cabal +13/−6

@@ -1,5 +1,52 @@ # Revision history for zeolite-lang +## 0.6.0.0  -- 2020-05-14++### Compiler CLI++* **[behavior]** Improves error messages for type mismatches and return-count+  mismatches.++* **[behavior]** Improves the efficiency of loading metadata for dependencies.++* **[breaking]** Fixes module-staleness check when running tests (`-t`).++* **[breaking]** Prevents binaries from being created from main categories that+  are defined in `$TestsOnly$` sources. (This was the original intention, but it+  was missed the first time around.)++### Language++* **[new]** Allows `@category` members in `concrete` categories to refer to each+  other during initialization.++* **[new]** Adds the `$ExprLookup[`*`MACRO_NAME`*`]$` pragma, which allows the+  user to define expression substitutions in `.zeolite-module`.++* **[new]** Adds the `$NoTrace$` pragma, which skips generating stack-trace+  information for specific functions. This is useful for deeply-recursive+  functions whose full trace would not be useful.++* **[new]** Adds the `$TraceCreation$` pragma, which appends a trace for the+  creation of a value when there is a crash in one of its functions. This is+  useful when the crash stems from value initialization.++* **[fix]** Fixes parsing of the `'"'` `Char`-literal.++### Libraries++* **[new]** Adds the `ErrorOr<#x>` category to `lib/util`. This allows functions+  to return either the expected type or an error message.++* **[new]** Adds the `Void` category to `lib/util`. This can be used to ignore+  type parameters when a value still needs to be instantiated.++* **[new]** Adds the `readAll` function to `TextReader` (in `lib/util`) to+  support reading an entire file at once.++* **[breaking]** Adds crashes when attempting to read `RawFileReader` or write+  `RawFileWriter` if there is a preexisting file error.+ ## 0.5.0.0  -- 2020-05-12  * **[new]** Adds compiler support for pragmas, which will allow compiler

@@ -40,11 +40,21 @@       std::cerr << " '" << condition_ << "'";     }     std::cerr << ": " << output_.str() << std::endl;-    for (const auto& trace : TraceContext::GetTrace()) {+    const TraceList call_trace = TraceContext::GetTrace();+    for (const auto& trace : call_trace) {       if (!trace.empty()) {         std::cerr << "  " << trace << std::endl;       }     }+    const TraceList creation_trace = TraceCreation::GetTrace();+    if (!creation_trace.empty()) {+      std::cerr << TraceCreation::GetType() << " value originally created at:" << std::endl;+      for (const auto& trace : creation_trace) {+        if (!trace.empty()) {+          std::cerr << "  " << trace << std::endl;+        }+      }+    }     std::raise(signal_);   } }@@ -92,8 +102,8 @@ }  -std::list<std::string> TraceContext::GetTrace() {-  std::list<std::string> trace;+TraceList TraceContext::GetTrace() {+  TraceList trace;   const TraceContext* current = GetCurrent();   while (current) {     current->AppendTrace(trace);@@ -107,7 +117,7 @@   at_ = at; } -void SourceContext::AppendTrace(std::list<std::string>& trace) const {+void SourceContext::AppendTrace(TraceList& trace) const {   std::ostringstream output;   if (at_ == nullptr || at_[0] == 0x00) {     output << "From " << name_;@@ -126,7 +136,7 @@   at_ = at; } -void CleanupContext::AppendTrace(std::list<std::string>& trace) const {+void CleanupContext::AppendTrace(TraceList& trace) const {   std::ostringstream output;   if (at_ == nullptr || at_[0] == 0x00) {     output << "In cleanup block";

@@ -73,6 +73,12 @@   #define PRED_CONTEXT_POINT(point) \     TraceContext::SetContext(point), +  #define CAPTURE_CREATION \+    CreationTrace creation_context_;++  #define TRACE_CREATION \+    TraceCreation trace_creation(TypeInstance::TypeName(parent), creation_context_);+ #else    #define TRACE_FUNCTION(name)@@ -83,11 +89,19 @@    #define PRED_CONTEXT_POINT(point) +  #define CAPTURE_CREATION++  #define TRACE_CREATION+ #endif ++using TraceList = std::list<std::string>;++ class TraceContext : public capture_thread::ThreadCapture<TraceContext> {  public:-  static std::list<std::string> GetTrace();+  static TraceList GetTrace();    template<int S>   static inline void SetContext(const char(&at)[S]) {@@ -101,7 +115,7 @@   private:   virtual void SetLocal(const char*) = 0;-  virtual void AppendTrace(std::list<std::string>& trace) const = 0;+  virtual void AppendTrace(TraceList& trace) const = 0;   virtual const TraceContext* GetNext() const = 0; }; @@ -113,7 +127,7 @@   private:   void SetLocal(const char*) final;-  void AppendTrace(std::list<std::string>& trace) const final;+  void AppendTrace(TraceList& trace) const final;   const TraceContext* GetNext() const final;    const char* at_;@@ -128,7 +142,7 @@   private:   void SetLocal(const char*) final;-  void AppendTrace(std::list<std::string>& trace) const final;+  void AppendTrace(TraceList& trace) const final;   const TraceContext* GetNext() const final;    const char* at_;@@ -156,6 +170,46 @@   const std::vector<std::string>& GetArgs() const final;    const std::vector<std::string> argv_;+  const ScopedCapture capture_to_;+};++class CreationTrace {+ public:+  inline CreationTrace() : trace_(TraceContext::GetTrace()) {}++  inline const TraceList& GetTrace() const {+    return trace_;+  }++ private:+  const TraceList trace_;+};++class TraceCreation : public capture_thread::ThreadCapture<TraceCreation> {+ public:+  inline TraceCreation(std::string type, const CreationTrace& trace)+    : type_(type), trace_(trace), capture_to_(this) {}++  static inline std::string GetType() {+    if (GetCurrent()) {+      return GetCurrent()->type_;+    } else {+      return std::string();+    }+  }++  static inline TraceList GetTrace() {+    if (GetCurrent()) {+      return GetCurrent()->trace_.GetTrace();+    } else {+      return TraceList();+    }+  }++ private:++  const std::string type_;+  const CreationTrace& trace_;   const ScopedCapture capture_to_; }; 

@@ -0,0 +1,9 @@+root: "../.."+path: "example/parser"+public_deps: [+  "lib/util"+]+private_deps: [+  "lib/file"+]+mode: incremental {}

@@ -0,0 +1,81 @@+# Zeolite Parser Example++*Also see+[a highlighted version of the example code](https://ta0kira.github.io/zeolite/example/parser).*++This example demonstrates parsing text using a parser-combinator approach+inspired by [`parsec`][parsec]. (The Haskell library that the `zeolite` compiler+uses to parse source and config files.)++## Notes++This example highlights several distinguishing features of the+[Zeolite language][zeolite]:++- **Encapsulation.** Data encapsulation is mandatory in Zeolite. This forces the+  code author to think about usage patterns before data representation.++- **Factory Functions.** There is no "default construction" in Zeolite; the code+  author must explicitly expose factory functions if needed. In this example,+  most of the factory functions return an interface, rather than the actual+  `concrete` type being constructed.++- **Internal Inheritance.** `ParseState` inherits `ParseContext` internally+  (see `parser.0rp` and `parser.0rx`), which allows `ParseState` to+  conditionally expose the `ParseContext` interface to other functions.++- **Function Merging.** `ParseState` and `ParseContext` declare some of the same+  functions in `parser.0rp`. When `ParseState` inherits `ParseContext`+  internally in `parser.0rx`, functions with the same names are merged by the+  compiler. This allows `ParseState` to expose a subset of `ParseContext`+  without needing a superfluous interface with the shared functions.++- **Parameter Variance.** Several categories used in this example (e.g.,+  `ParseState` and `ParseContext`) have a *covariant* parameter, which allows+  their parameters to be converted to other types. Specifically:++  - Any `ParseContext<#x>` can be converted to `ParseContext<any>` when calling+    `Parser.run`. (In C++ this would require a `template` and in Java it would+    require using `<?>`.)++  - The `ParseState<all>` returned from `ParseContext.setBrokenInput` can be+    converted to all other `ParseState<#x>`. (In C++ or Java this would require+    the caller to explicitly pass a type parameter to `setBrokenInput`.)++- **Multiple Returns.** Many of the functions in this example return more than+  one value to the caller. (In C++ and Java this would require a data structure+  for grouping objects together.)++- **Test Sources.** The `parser-test.0rt` source file contains a `testcase` that+  the compiler itself can execute.++- **Expression Pragmas.** `parser-test.0rt` uses the `$ExprLookup[MODULE_PATH]$`+  pragma to get the absolute path to its own module in order to locate a data+  file. This might otherwise require hard-coding a path or relying on the tests+  being executed from the module path.++- **Module Config.** The `.zeolite-module` file contains the build configuration+  for this example. This means that building and running the example does not+  require special instructions, scripting, or `Makefile`s.++## Running++(Included with compiler package starting with version `0.6.0.0`.)++To run the example:++```shell+# This is just to locate the example code. Not for normal use!+ZEOLITE_PATH=$(zeolite --get-path)++# Compile the example.+zeolite -p "$ZEOLITE_PATH" -r example/parser++# Run the unit tests.+zeolite -p "$ZEOLITE_PATH" -t example/parser+```++(There is currently no binary target in this example.)++[parsec]: https://hackage.haskell.org/package/parsec+[zeolite]: https://github.com/ta0kira/zeolite

@@ -0,0 +1,27 @@+/* Parses a fixed string.+ */+concrete StringParser {+  @type create (String) -> (Parser<String>)+}++/* Parses a string containing a limited set of characters.+ */+concrete SequenceOfParser {+  @type create (String, Int /*min*/, Int /*max*/) -> (Parser<String>)+}++/* Parses a fixed character.+ */+concrete CharParser {+  @type create (Char) -> (Parser<Char>)+}++/* Parser combinators.+ */+concrete Parse {+  @type const<#x> (#x)                     -> (Parser<#x>)+  @type try<#x>   (Parser<#x>)             -> (Parser<#x>)+  @type or<#x>    (Parser<#x>,Parser<#x>)  -> (Parser<#x>)+  @type left<#x>  (Parser<#x>,Parser<any>) -> (Parser<#x>)+  @type right<#x> (Parser<any>,Parser<#x>) -> (Parser<#x>)+}

@@ -0,0 +1,254 @@+define StringParser {+  refines Parser<String>++  @value String match++  run (contextOld) {+    if (contextOld.hasAnyError()) {+      return contextOld.convertError<String>()+    }+    String message <- "Failed to match \"" + match + "\" at " + contextOld.getPosition()+    ParseContext<any> context <- contextOld+    scoped {+      Int index <- 0+    } in while (index < match.readSize()) {+      if (context.atEof() || context.current() != match.readPosition(index)) {+        if (index > 0) {+          // Partial match => set error context.+          return context.setBrokenInput(message)+        } else {+          return context.setValue<String>(ErrorOr$$error(message))+        }+      }+    } update {+      index <- index+1+      context <- context.advance()+    }+    return context.setValue<String>(ErrorOr$$value<String>(match))+  }++  create (match) {+    return StringParser{ match }+  }+}++define SequenceOfParser {+  refines Parser<String>++  @value String matches+  @value Int    min+  @value Int    max++  run (contextOld) {+    if (contextOld.hasAnyError()) {+      return contextOld.convertError<String>()+    }+    String message <- "Failed to match [" + matches + "]{" ++                      min.formatted() + "," + max.formatted() + "} at " ++                      contextOld.getPosition()+    ParseContext<any> context <- contextOld+    Builder<String> builder <- String$builder()+    Int count <- 0+    while (!context.atEof() && (max == 0 || count < max)) {+      Bool found <- false+      scoped {+        Int index <- 0+      } in while (index < matches.readSize()) {+        if (context.current() == matches.readPosition(index)) {+          \ builder.append(matches.readPosition(index).formatted())+          found <- true+          break+        }+      } update {+        index <- index+1+      }+      if (!found) {+        break+      }+    } update {+      count <- count+1+      context <- context.advance()+    }+    if (count >= min) {+      return context.setValue<String>(ErrorOr$$value<String>(builder.build()))+    } elif (count > 0) {+      // Partial match => set error context.+      return context.setBrokenInput(message)+    } else {+      return context.setValue<String>(ErrorOr$$error(message))+    }+  }++  create (matches,min,max) {+    return SequenceOfParser{ matches, min, max }+  }+}++define CharParser {+  refines Parser<Char>++  @value Char match++  run (contextOld) {+    if (contextOld.hasAnyError()) {+      return contextOld.convertError<Char>()+    }+    if (contextOld.atEof() || contextOld.current() != match) {+      String message <- "Failed to match '" + match.formatted() + "' at " + contextOld.getPosition()+      return contextOld.setValue<Char>(ErrorOr$$error(message))+    } else {+      return contextOld.advance().setValue<Char>(ErrorOr$$value<Char>(match))+    }+  }++  create (match) {+    return CharParser{ match }+  }+}++concrete ConstParser<#x> {+  @type create (#x) -> (Parser<#x>)+}++define ConstParser {+  refines Parser<#x>++  @value #x value++  run (contextOld) {+    return contextOld.setValue<#x>(ErrorOr$$value<#x>(value))+  }++  create (value) {+    return ConstParser<#x>{ value }+  }+}++concrete TryParser<#x> {+  @type create (Parser<#x>) -> (Parser<#x>)+}++define TryParser {+  refines Parser<#x>++  @value Parser<#x> parser++  run (contextOld) {+    if (contextOld.hasAnyError()) {+      return contextOld.convertError<#x>()+    }+    ParseContext<#x> context <- contextOld.run<#x>(parser)+    if (context.hasAnyError()) {+      return contextOld.setValue<#x>(context.getValue().convertError())+    } else {+      return context.toState()+    }+  }++  create (parser) {+    return TryParser<#x>{ parser }+  }+}++concrete OrParser<#x> {+  @type create (Parser<#x>,Parser<#x>) -> (Parser<#x>)+}++define OrParser {+  refines Parser<#x>++  @value Parser<#x> parser1+  @value Parser<#x> parser2++  run (contextOld) {+    if (contextOld.hasAnyError()) {+      return contextOld.convertError<#x>()+    }+    ParseContext<#x> context <- contextOld.run<#x>(parser1)+    if (context.hasAnyError() && !context.hasBrokenInput()) {+      return contextOld.run<#x>(parser2).toState()+    } else {+      return context.toState()+    }+  }++  create (parser1,parser2) {+    return OrParser<#x>{ parser1, parser2 }+  }+}++concrete LeftParser<#x> {+  @type create (Parser<#x>,Parser<any>) -> (Parser<#x>)+}++define LeftParser {+  refines Parser<#x>++  @value Parser<#x>  parser1+  @value Parser<any> parser2++  run (contextOld) {+    if (contextOld.hasAnyError()) {+      return contextOld.convertError<#x>()+    }+    ParseContext<#x> context <- contextOld.run<#x>(parser1)+    if (!context.hasAnyError()) {+      return context.run<any>(parser2).setValue<#x>(context.getValue())+    } else {+      return context.toState()+    }+  }++  create (parser1,parser2) {+    return LeftParser<#x>{ parser1, parser2 }+  }+}++concrete RightParser<#x> {+  @type create (Parser<any>,Parser<#x>) -> (Parser<#x>)+}++define RightParser {+  refines Parser<#x>++  @value Parser<any> parser1+  @value Parser<#x>  parser2++  run (contextOld) {+    if (contextOld.hasAnyError()) {+      return contextOld.convertError<#x>()+    }+    ParseContext<any> context <- contextOld.run<any>(parser1)+    if (!context.hasAnyError()) {+      return context.run<#x>(parser2).toState()+    } else {+      return context.convertError<#x>()+    }+  }++  create (parser1,parser2) {+    return RightParser<#x>{ parser1, parser2 }+  }+}++define Parse {+  const (value) {+    return ConstParser<#x>$create(value)+  }++  try (parser) {+    return TryParser<#x>$create(parser)+  }++  or (parser1,parser2) {+    return OrParser<#x>$create(parser1,parser2)+  }++  left (parser1,parser2) {+    return LeftParser<#x>$create(parser1,parser2)+  }++  right (parser1,parser2) {+    return RightParser<#x>$create(parser1,parser2)+  }+}

@@ -0,0 +1,34 @@+testcase "parse data from a file" {+  success Test$execute()+}++concrete Test {+  @type execute () -> ()+}++define Test {+  execute () {+    TestData data <- TestData$parseFrom(loadTestData()).getValue()++    if (data.getName() != "example data") {+      fail(data.getName())+    }++    if (data.getDescription() != "THIS_IS_A_TOKEN") {+      fail(data.getDescription())+    }++    if (data.getBoolean() != false) {+      fail(data.getBoolean())+    }+  }++  @type loadTestData () -> (String)+  loadTestData () {+    scoped {+      RawFileReader reader <- RawFileReader$open($ExprLookup[MODULE_PATH]$ + "/test-data.txt")+    } cleanup {+      \ reader.freeResource()+    } in return TextReader$readAll(reader)+  }+}

@@ -0,0 +1,51 @@+/* Manages state for parsing operations outside of a Parser.+ *+ * The state is immutable; all update operations return a new state.+ *+ * Since #x is covariant, any ParseState can convert to ParseState<any>, and+ * ParseState<all> can convert to all other ParseState.+ */+concrete ParseState<|#x> {+  @category new (String) -> (ParseState<any>)++  @value run<#y>       (Parser<#y>) -> (ParseState<#y>)+  @value runAndGet<#y> (Parser<#y>) -> (ParseState<any>,ErrorOr<#y>)++  @value atEof       () -> (Bool)+  @value hasAnyError () -> (Bool)+  @value getError    () -> (Formatted)+}++/* A self-contained parser operation.+ *+ * Since #x is covariant, any Parser can convert to Parser<any>, and Parser<all>+ * can convert to all other Parser.+ */+@value interface Parser<|#x> {+  run (ParseContext<any>) -> (ParseState<#x>)+}++/* Parser context available when running a Parser.+ *+ * Since #x is covariant, any ParseContext can convert to ParseContext<any>, and+ * ParseContext<all> can convert to all other ParseContext.+ */+@value interface ParseContext<|#x> {+  run<#y>       (Parser<#y>) -> (ParseContext<#y>)+  runAndGet<#y> (Parser<#y>) -> (ParseContext<any>,ErrorOr<#y>)++  convertError<#y> ()            -> (ParseState<#y>)+  getValue         ()            -> (ErrorOr<#x>)+  setValue<#y>     (ErrorOr<#y>) -> (ParseState<#y>)+  setBrokenInput   (Formatted)   -> (ParseState<all>)+  toState          ()            -> (ParseState<#x>)++  getPosition () -> (String)++  atEof          () -> (Bool)+  hasAnyError    () -> (Bool)+  hasBrokenInput () -> (Bool)++  current () -> (Char)+  advance () -> (ParseContext<#x>)+}

@@ -0,0 +1,120 @@+define ParseState {+  // This internal inheritance takes advantage of function merging.+  //+  // Notice that several functions (e.g., run, hasAnyError) appear to be+  // declared separately in ParseState and ParseContext in parser.0rp. Since the+  // function types are compatible, the compiler automatically merges them. This+  // allows ParseState to expose a subset of ParseContext without needing a+  // superfluous interface that both categories refine.+  refines ParseContext<#x>++  @value String             data+  @value Int                index+  @value Int                line+  @value Int                char+  @value ErrorOr<#x>        value+  @value optional Formatted error++  new (data) {+    return ParseState<any>{ data, 0, 0, 0, ErrorOr$$value<Void>(Void$void()), empty }+  }++  run (parser) {+    return parser.run(self)+  }++  runAndGet (parser) {+    ParseState<#y> context <- parser.run(self)+    return context, context.getValue()+  }++  convertError () {+    return ParseState<#y>{ data, index, line, char, ErrorOr$$error(getError()), error }+  }++  getValue () {+    if (present(error)) {+      return ErrorOr$$error(require(error))+    } else {+      return value+    }+  }++  setValue (value2) {+    if (hasBrokenInput()) {+      return convertError<#y>()+    } else {+      return ParseState<#y>{ data, index, line, char, value2, error }+    }+  }++  setBrokenInput (message) {+    return ParseState<all>{ data, index, line, char, ErrorOr$$error(message), message }+  }++  toState () {+    return self+  }++  getPosition () {+    return String$builder()+        .append("(")+        .append(line.formatted())+        .append(",")+        .append(char.formatted())+        .append(")")+        .build()+  }++  atEof () {+    return index >= data.readSize()+  }++  hasAnyError () {+    return present(error) || value.isError()+  }++  hasBrokenInput () {+    return present(error)+  }++  current () {+    \ sanityCheck()+    return data.readPosition(index)+  }++  advance () {+    \ sanityCheck()+    if (data.readPosition(index) == '\n') {+      return ParseState<#x>{ data, index+1, line+1, 0, value, error }+    } else {+      return ParseState<#x>{ data, index+1, line, char+1, value, error }+    }+  }++  getError () {+    if (present(error)) {+      return require(error)+    } else {+      return value.getError()+    }+  }++  @value sanityCheck () -> ()+  sanityCheck () {+    if (hasBrokenInput()) {+      \ LazyStream<Formatted>$new()+          .append("Error at ")+          .append(getPosition())+          .append(": ")+          .append(getError())+          .writeTo(SimpleOutput$error())+    }+    if (atEof()) {+      \ LazyStream<Formatted>$new()+          .append("Reached end of input at ")+          .append(getPosition())+          .writeTo(SimpleOutput$error())+    }+  }+}

@@ -0,0 +1,11 @@+$TestsOnly$++/* Parses the test-data.txt file using a one-off format.+ */+concrete TestData {+  @type parseFrom (String) -> (ErrorOr<TestData>)++  @value getName        () -> (String)+  @value getDescription () -> (String)+  @value getBoolean     () -> (Bool)+}

@@ -0,0 +1,85 @@+$TestsOnly$++define TestData {+  @category Parser<any> whitespace <- SequenceOfParser$create(" \n\t",1,0)++  @category Parser<String> sentence        <- SentenceParser$create()+  @category Parser<String> token           <- SequenceOfParser$create("ABCDEFGHIJKLMNOPQRSTUVWXYZ_",1,0)+  @category Parser<String> sentenceOrToken <- sentence `Parse$or<String>` token `Parse$left<String>` whitespace++  @category Parser<Bool> acronym           <- StringParser$create("acronym")  `Parse$right<Bool>` Parse$const<Bool>(true)+  @category Parser<Bool> aardvark          <- StringParser$create("aardvark") `Parse$right<Bool>` Parse$const<Bool>(false)+  @category Parser<Bool> acronymOrAardvark <- `Parse$try<Bool>` acronym `Parse$or<Bool>` aardvark `Parse$left<Bool>` whitespace++  @category Parser<any> fileStart      <- StringParser$create("file_start")   `Parse$left<any>` whitespace+  @category Parser<any> fileEnd        <- StringParser$create("file_end")     `Parse$left<any>` whitespace+  @category Parser<any> nameTag        <- StringParser$create("name:")        `Parse$left<any>` whitespace+  @category Parser<any> descriptionTag <- StringParser$create("description:") `Parse$left<any>` whitespace+  @category Parser<any> aWordTag       <- StringParser$create("a_word:")      `Parse$left<any>` whitespace++  @value String name+  @value String description+  @value Bool   boolean++  parseFrom (data) {+    ParseState<any> state <- ParseState$$new(data)+    state                              <- state.run<any>(fileStart)+    state                              <- state.run<any>(nameTag)+    state, ErrorOr<String> name        <- state.runAndGet<String>(sentenceOrToken)+    state                              <- state.run<any>(descriptionTag)+    state, ErrorOr<String> description <- state.runAndGet<String>(sentenceOrToken)+    state                              <- state.run<any>(aWordTag)+    state, ErrorOr<Bool> boolean       <- state.runAndGet<Bool>(acronymOrAardvark)+    state                              <- state.run<any>(fileEnd)++    if (state.hasAnyError()) {+      return ErrorOr$$error(state.getError())+    } elif (!state.atEof()) {+      return ErrorOr$$error("Parsing did not consume all of the data")+    } else {+      return ErrorOr$$value<TestData>(TestData{ name.getValue(),+                                                description.getValue(),+                                                boolean.getValue() })+    }+  }++  getName () {+    return name+  }++  getDescription () {+    return description+  }++  getBoolean () {+    return boolean+  }+}++concrete SentenceParser {+  @type create () -> (Parser<String>)+}++define SentenceParser {+  refines Parser<String>++  @category String sentenceChars <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ++                                    "abcdefghijklmnopqrstuvwxyz" ++                                    "., !?-"+  @category Parser<String> string <- SequenceOfParser$create(sentenceChars,0,0)++  run (contextOld) {+    if (contextOld.hasAnyError()) {+      return contextOld.convertError<String>()+    }+    ParseContext<any> context <- contextOld+    context                       <- context.run<any>(CharParser$create('"'))+    context, ErrorOr<String> text <- context.runAndGet<String>(string)+    context                       <- context.run<any>(CharParser$create('"'))+    return context.setValue<String>(text)+  }++  create () {+    return SentenceParser{ }+  }+}

@@ -0,0 +1,5 @@+file_start+  name:        "example data"+  description: THIS_IS_A_TOKEN+  a_word:      aardvark+file_end

@@ -1,20 +0,0 @@-# Zeolite Regex Example--*Also see-[a highlighted version of the example code](https://ta0kira.github.io/zeolite/example/regex).*--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 RegexDemo example/regex--# Run the unit tests.-zeolite -p "$ZEOLITE_PATH" -t example/regex--# Execute the compiled binary.-$ZEOLITE_PATH/example/regex/RegexDemo-```

@@ -1,4 +0,0 @@-concrete CharRegex {-  @type parse (String) -> (optional MatcherTemplate<Char>)-  @type match (MatcherTemplate<Char>,String) -> (Bool)-}

@@ -1,199 +0,0 @@-define CharRegex {-  parse (pattern) (matcher) {-    ReadIterator<Char> p <- ReadIterator$$fromReadPosition<Char>(pattern)-    // TODO: Needs error handling.-    _, matcher <- parseExpression(p)-  }--  match (template,data) {-    ReadIterator<Char> p <- ReadIterator$$fromReadPosition<Char>(data)-    Matcher<Char> matcher <- template.newMatcher()-    while (!p.pastForwardEnd()) {-      MatchState state <- matcher.tryNextMatch(p.readCurrent())-      if (state `MatchState$equals` MatchState$matchFail()) {-        break-      }-      p <- p.forward()-      if (state `MatchState$equals` MatchState$matchComplete()) {-        break-      }-    }-    return p.pastForwardEnd() && matcher.matchSatisfied()-  }--  @type parseSequence (ReadIterator<Char>) ->-                      (ReadIterator<Char>,optional ReadSequence<MatcherTemplate<Char>>)-  parseSequence (p) {-    if (p.pastForwardEnd()) {-      return p, empty-    }-    ReadIterator<Char> p2, optional MatcherTemplate<Char> matcher <- parseNonSequence(p)-    if (!p2.pastForwardEnd() && (p2.readCurrent() == '|' || p2.readCurrent() == ')')) {-      // Requires choice matching or the end of a subexpression.-      if (present(matcher)) {-        return p2, LinkedNode<MatcherTemplate<Char>>$create(require(matcher),empty)-      } else {-        // TODO: Disregards errors from parseNonSequence.-        return p2, LinkedNode<MatcherTemplate<Char>>$create(MatchEmpty$create(),empty)-      }-    } if (!present(matcher)) {-      return p2, empty-    } else {-      p2, optional ReadSequence<MatcherTemplate<Char>> sequence <- parseSequence(p2)-      return p2, LinkedNode<MatcherTemplate<Char>>$create(require(matcher),sequence)-    }-  }--  @type parseNonSequence (ReadIterator<Char>) ->-                         (ReadIterator<Char>,optional MatcherTemplate<Char>)-  parseNonSequence (p) (p2,matcher) {-    p2 <- p-    matcher <- empty-    while (!p2.pastForwardEnd()) {-      Char c <- p2.readCurrent()-      if (c == '|' || c == ')') {-        // Requires choice matching or the end of a subexpression.-        return _-      } elif (c == '*') {-        // TODO: Needs error handling.-        return p2.forward(),-               MatchBranches<Char>$create(BranchRepeat<Char>$createZeroPlus(require(matcher)))-      } elif (c == '+') {-        // TODO: Needs error handling.-        return p2.forward(),-               MatchBranches<Char>$create(BranchRepeat<Char>$createOnePlus(require(matcher)))-      } elif (c == '{') {-        p2, Int min, Int max <- parseRange(p2.forward())-        if (p2.pastForwardEnd() || p2.readCurrent() != '}') {-          // TODO: Needs error handling.-          fail("missing }")-        }-        return p2.forward(),-               MatchBranches<Char>$create(BranchRepeat<Char>$createRange(min,max,require(matcher)))-      } elif (present(matcher)) {-        return _-      } elif (c == '[') {-        p2, matcher <- parseCharChoices(p2.forward())-        if (p2.pastForwardEnd() || p2.readCurrent() != ']') {-          // TODO: Needs error handling.-          fail("missing ]")-        }-        p2 <- p2.forward()-      } elif (c == '(') {-        p2, matcher <- parseExpression(p2.forward())-        if (p2.pastForwardEnd() || p2.readCurrent() != ')') {-          // TODO: Needs error handling.-          fail("missing )")-        }-        p2 <- p2.forward()-      } else {-        p2, matcher <- parseSingleChar(p2)-      }-    }-  }--  @type parseRange (ReadIterator<Char>) -> (ReadIterator<Char>,Int,Int)-  parseRange (p) (p2,min,max) {-    max <- 0-    p2, min <- parseCount(p)-    if (p2.pastForwardEnd() || p2.readCurrent() != ',') {-      max <- min-    } else {-      p2, max <- parseCount(p2.forward())-    }-  }--  @type parseCount (ReadIterator<Char>) -> (ReadIterator<Char>,Int)-  parseCount (p) (p2,count) {-    // TODO: Needs error handling.-    count <- 0-    p2 <- p-    while (!p2.pastForwardEnd()) {-      Char c <- p2.readCurrent()-      if (c >= '0' && c <= '9') {-        count <- 10*count + (c - '0')-      } else {-        break-      }-    } update {-      p2 <- p2.forward()-    }-  }--  @type parseExpression (ReadIterator<Char>) ->-                        (ReadIterator<Char>,optional MatcherTemplate<Char>)-  parseExpression (p) (p2,matcher) {-    optional ReadSequence<MatcherTemplate<Char>> choices <- empty-    p2 <- p-    while (!p2.pastForwardEnd()) {-      p2, optional ReadSequence<MatcherTemplate<Char>> sequence <- parseSequence(p2)-      if (!present(sequence)) {-        break-      }-      choices <- LinkedNode<MatcherTemplate<Char>>$create(-          MatchBranches<Char>$create(BranchSequence<Char>$create(sequence)),choices)-      if (p2.pastForwardEnd() || p2.readCurrent() != '|') {-        break-      }-      p2 <- p2.forward()-    }-    if (!present(choices)) {-      matcher <- MatchEmpty$create()-    } else {-      matcher <- MatchChoices<Char>$create(choices)-    }-  }--  @type parseSingleChar (ReadIterator<Char>) ->-                        (ReadIterator<Char>,optional MatcherTemplate<Char>)-  parseSingleChar (p) (p2,matcher) {-    // TODO: Needs error handling.-    Char c <- p.readCurrent()-    p2 <- p.forward()-    if (c == '\\') {-      matcher <- MatchSingle<Char>$create(p2.readCurrent())-      p2 <- p.forward()-    } elif (c == '.') {-      matcher <- MatchAny$create()-    } else {-      matcher <- MatchSingle<Char>$create(c)-    }-  }--  @type parseCharChoices (ReadIterator<Char>) ->-                         (ReadIterator<Char>,optional MatcherTemplate<Char>)-  parseCharChoices (p) (p2,matcher) {-    p2 <- p-    matcher <- empty-    optional Char previous <- empty-    Bool doRange <- false-    optional ReadSequence<MatcherTemplate<Char>> choices <- empty-    while (!p2.pastForwardEnd()) {-      Char c <- p2.readCurrent()-      if (c == '\\') {-        p2 <- p2.forward()-        c <- p2.readCurrent()-      }-      if (c == ']') {-        break-      } elif (c == '-' && present(previous) && !doRange) {-        doRange <- true-      } elif (doRange) {-        choices <- LinkedNode<MatcherTemplate<Char>>$create(MatchRange<Char>$create(require(previous),c),choices)-        previous <- empty-        doRange <- false-      } elif (present(previous)) {-        choices <- LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create(require(previous)),choices)-        previous <- c-      } else {-        previous <- c-      }-    } update {-      p2 <- p2.forward()-    }-    if (present(previous)) {-      choices <- LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create(require(previous)),choices)-    }-    matcher <- MatchChoices<Char>$create(choices)-  }-}

@@ -1,92 +0,0 @@-concrete RegexDemo {-  @type run () -> ()-}--define RegexDemo {-  run () {-    \ testMatch("","",true)-    \ testMatch("","a",false)-    \ testMatch(".","a",true)-    \ testMatch(".","aa",false)-    \ testMatch("a",".",false)-    \ testMatch(".+","",false)-    \ testMatch(".+","a",true)-    \ testMatch(".+","ab",true)-    \ testMatch(".*.","a",true)-    \ testMatch(".*.","ab",true)-    \ testMatch("(ab)*","",true)-    \ testMatch("(ab)*","abab",true)-    \ testMatch("(ab)*","a",false)-    \ testMatch("(ab)*ac","abac",true)-    \ testMatch("(ab)*ac","ac",true)-    \ testMatch("(ab)*ac","aca",false)-    \ testMatch("(ab)*ac","acab",false)-    \ testMatch("(ab)*|ac","abab",true)-    \ testMatch("(ab)*|ac","ac",true)-    \ testMatch("(ab)*|ac","acac",false)-    \ testMatch("(ab)*|ac","abac",false)-    \ testMatch("a{2}","a",false)-    \ testMatch("a{2}","aa",true)-    \ testMatch("a{2}","aaa",false)-    \ testMatch("a{2,3}","a",false)-    \ testMatch("a{2,3}","aa",true)-    \ testMatch("a{2,3}","aaa",true)-    \ testMatch("a{2,3}","aaaa",false)-    \ testMatch("(a+){4}","aaa",false)-    \ testMatch("(a+){4}","aaaa",true)-    \ testMatch("(a+){4}","aaaaa",true)-    \ testMatch("(a+){4}","aaaaaa",true)-    \ testMatch("[a-z?]","q",true)-    \ testMatch("[a-z?]","-",false)-    \ testMatch("[a-z?]","?",true)-    \ testMatch("[a-z?]*","abcde?",true)-    \ testMatch("[a-z?]*","ab-cde",false)--    // A few malicious regexes from https://en.wikipedia.org/wiki/ReDoS.-    //-    // The first three below don't finish, due to repeat branching. The-    // branching of "a+" is O(sqrt(2)^n) and "(a+)+" is therefore O(2^n).-    //-    // The first two could still be matched using non-branching repeats, since-    // there is a complete overlap between the tail of one repeat and the next-    // repeat, and repeats past 1 don't matter. The third could also be if the-    // first 30 were expanded at the beginning.-    //-    // Overall, the safer solution would be to avoid repeat branching, and have-    // a disclaimer about matching accuracy with repeated unbounded patterns-    // that overlap themselves.--    // \ testMatch("(a+)+","aaaaaaaaaaaaaaaaaaaaaaaa!",false)-    // \ testMatch("(a+)+","aaaaaaaaaaaaaaaaaaaaaaaa!",false)-    // \ testMatch("([a-zA-Z]+)*","aaaaaaaaaaaaaaaaaaaaaaaa!",false)-    // \ testMatch("(.*a){30}","aaaaaaaaaaaaaaaaaaaaaaaa!",false)-    \ testMatch("(a|aa)+","aaaaaaaaaaaaaaaaaaaaaaaa!",false)--    // This causes a ton of branching, but it actually finishes. Given m-    // unbounded groups in a sequence, the branching is O(n^m). Since n^m-    // increases rapidly with n, most sequence branches at any given time will-    // not contain repeat branches within them. The exception is that each of-    // the m groups will be in separate sequence branches from the beginning,-    // *adding* O(sqrt(2)^n) branches. This means the overall complexity is-    // O(n^m)+O(sqrt(2)^n): O(n^m) for smaller n, O(sqrt(2)^n) for larger n.-    \ testMatch("[ab]*[ac]*[ad]*[ae]*[af]*",-                "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaad",true)-  }--  @type testMatch (String,String,Bool) -> ()-  testMatch (pattern,data,expected) {-    MatcherTemplate<Char> template <- require(CharRegex$parse(pattern))-    \ LazyStream<Formatted>$new()-        .append("Trying: regex=\"")-        .append(pattern)-        .append("\" data=\"")-        .append(data)-        .append("\" -> ")-        .append(expected)-        .append("...\n")-        .writeTo(SimpleOutput$stderr())-    if (CharRegex$match(template,data) != expected) {-      fail("Incorrect match result!")-    }-  }-}

@@ -1,1338 +0,0 @@-testcase "MatchSingle match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "x"-    MatcherTemplate<Char> template <- MatchSingle<Char>$create('x')-    Matcher<Char> matcher <- template.newMatcher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Should only match once.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Should match again after reset.-    matcher <- template.newMatcher()-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-  }-}---testcase "MatchSingle non-match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "x"-    MatcherTemplate<Char> template <- MatchSingle<Char>$create('x')-    Matcher<Char> matcher <- template.newMatcher()--    MatchState state <- matcher.tryNextMatch('y')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }--    // Should keep failing to match.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-  }-}---testcase "MatchRange match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]"-    MatcherTemplate<Char> template <- MatchRange<Char>$create('w','y')-    Matcher<Char> matcher <- template.newMatcher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Should only match once.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Should match again after reset.-    matcher <- template.newMatcher()-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-  }-}---testcase "MatchRange non-match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]"-    MatcherTemplate<Char> template <- MatchRange<Char>$create('w','y')-    Matcher<Char> matcher <- template.newMatcher()--    MatchState state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }--    // Should keep failing to match.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-  }-}---testcase "MatchAny" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "."-    MatcherTemplate<Char> template <- MatchAny$create()-    Matcher<Char> matcher <- template.newMatcher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Should only match once.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Should match again after reset.-    matcher <- template.newMatcher()-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-  }-}---testcase "MatchEmpty" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: ""-    MatcherTemplate<Char> template <- MatchEmpty$create()-    Matcher<Char> matcher <- template.newMatcher()--    if (!template.matchesEmpty()) {-      fail("doesn't match empty")-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    MatchState state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Should match again after reset.-    matcher <- template.newMatcher()-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }-  }-}---testcase "MatchRepeat match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]{2,3}"-    MatcherTemplate<Char> template <--        MatchRepeat<Char>$createRange(2,3,MatchRange<Char>$create('w','y'))-    Matcher<Char> matcher <- template.newMatcher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('y')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Third character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }--    // Fourth character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Reset to reuse the matcher.-    matcher <- template.newMatcher()--    // Fourth character.-    state <- matcher.tryNextMatch('w')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Fifth character.-    state <- matcher.tryNextMatch('w')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }-  }-}---testcase "MatchRepeat nested" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "(x*){2,}"-    MatcherTemplate<Char> template <--        MatchRepeat<Char>$createRange(2,0,-            MatchRepeat<Char>$createZeroPlus(MatchSingle<Char>$create('x')))-    Matcher<Char> matcher <- template.newMatcher()--    if (!template.matchesEmpty()) {-      fail("doesn't match empty")-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Third character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }-  }-}---testcase "MatchRepeat non-match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]{2,3}"-    MatcherTemplate<Char> template <--        MatchRepeat<Char>$createRange(2,3,MatchRange<Char>$create('w','y'))-    Matcher<Char> matcher <- template.newMatcher()--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('q')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Should keep failing to match.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-  }-}---testcase "MatchRepeat optional suffix" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "(ab*)*"-    MatcherTemplate<Char> template <--        MatchRepeat<Char>$createZeroPlus(-            MatchBranches<Char>$create(-                BranchSequence<Char>$create(-                    LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('a'),-                        LinkedNode<MatcherTemplate<Char>>$create(-                            MatchRepeat<Char>$createZeroPlus(MatchSingle<Char>$create('b')),empty)))))-    Matcher<Char> matcher <- template.newMatcher()--    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('b')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Third character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }-  }-}---testcase "MatchChoices match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]|a*"-    MatcherTemplate<Char> template <--        MatchChoices<Char>$create(-            LinkedNode<MatcherTemplate<Char>>$create(MatchRange<Char>$create('w','y'),-                LinkedNode<MatcherTemplate<Char>>$create(-                    MatchBranches<Char>$create(-                        BranchRepeat<Char>$createZeroPlus(MatchSingle<Char>$create('a'))),empty)))-    Matcher<Char> matcher <- template.newMatcher()--    MatchState state <- MatchState$matchFail()--    if (!template.matchesEmpty()) {-      fail("doesn't match empty")-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // First character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }--    // Second character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }--    // Third character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }--    // Reset to reuse the matcher.-    matcher <- template.newMatcher()--    // First character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-  }-}---testcase "MatchChoices non-match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]|a*"-    MatcherTemplate<Char> template <--        MatchChoices<Char>$create(-            LinkedNode<MatcherTemplate<Char>>$create(MatchRange<Char>$create('w','y'),-                LinkedNode<MatcherTemplate<Char>>$create(-                    MatchBranches<Char>$create(-                        BranchRepeat<Char>$createZeroPlus(MatchSingle<Char>$create('a'))),empty)))-    Matcher<Char> matcher <- template.newMatcher()--    if (!template.matchesEmpty()) {-      fail("doesn't match empty")-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }--    // Should keep failing to match.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-  }-}---testcase "MatchChoices empty choice" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]|a{2,2}|"-    MatcherTemplate<Char> template <--        MatchChoices<Char>$create(-            LinkedNode<MatcherTemplate<Char>>$create(MatchRange<Char>$create('w','y'),-                LinkedNode<MatcherTemplate<Char>>$create(-                    MatchBranches<Char>$create(-                        BranchRepeat<Char>$createRange(2,2,MatchSingle<Char>$create('a'))),-                    LinkedNode<MatcherTemplate<Char>>$create(-                        MatchEmpty$create(),empty))))-    Matcher<Char> matcher <- template.newMatcher()--    if (!template.matchesEmpty()) {-      fail("doesn't match empty")-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }-  }-}---testcase "BranchRepeat match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]{2,3}"-    MatchBrancherTemplate<Char> template <--        BranchRepeat<Char>$createRange(2,3,MatchRange<Char>$create('w','y'))-    MatchBrancher<Char> brancher <- template.newBrancher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (brancher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<Char>> branches <- empty--    // First character.-    state, branches <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }--    brancher <- require(branches).value()-    if (brancher.matchSatisfied()) {-      fail("match satisfied")-    }-    branches <- require(branches).next()-    if (present(branches)) {-      fail("branch present")-    }--    // Second character.-    state, branches <- brancher.tryBranches('y')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }-    if (!brancher.matchSatisfied()) {-      fail("match not satisfied")-    }--    brancher <- require(branches).value()-    branches <- require(branches).next()-    if (present(branches)) {-      fail("branch present")-    }--    // Third character.-    state, branches <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-    if (present(branches)) {-      fail("branch present")-    }--    // Reset to reuse the brancher.-    brancher <- template.newBrancher()--    // Fourth character.-    state, branches <- brancher.tryBranches('w')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }-  }-}---testcase "BranchRepeat nested" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "(x*){2,}"-    MatchBrancherTemplate<Char> template <--        BranchRepeat<Char>$createRange(2,0,-            MatchBranches<Char>$create(-                BranchRepeat<Char>$createZeroPlus(MatchSingle<Char>$create('x'))))-    MatchBrancher<Char> brancher <- template.newBrancher()--    if (!template.matchesEmpty()) {-      fail("doesn't match empty")-    }-    if (!brancher.matchSatisfied()) {-      fail("match not satisfied")-    }--    MatchState state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<Char>> branches <- empty--    // First character.-    state, branches <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }--    brancher <- require(branches).value()-    if (!brancher.matchSatisfied()) {-      fail("match not satisfied")-    }-    branches <- require(branches).next()-    if (present(branches)) {-      fail("branch present")-    }--    // Second character.-    state, branches <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }--    brancher <- require(branches).value()-    if (!brancher.matchSatisfied()) {-      fail("match not satisfied")-    }-    // Expect one additional branch to continue "xx*".-    branches <- require(branches).next()-    if (!present(branches)) {-      fail("branch missing")-    }--    // Third character, branch 1.-    state, _ <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }--    brancher <- require(branches).value()-    if (!brancher.matchSatisfied()) {-      fail("match not satisfied")-    }-    // No more branches expected.-    branches <- require(branches).next()-    if (present(branches)) {-      fail("branch present")-    }--    // Third character, branch 2.-    state, _ <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-  }-}---testcase "BranchRepeat non-match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]{2,3}"-    MatchBrancherTemplate<Char> template <--        BranchRepeat<Char>$createRange(2,3,MatchRange<Char>$create('w','y'))-    MatchBrancher<Char> brancher <- template.newBrancher()--    MatchState state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<Char>> branches <- empty--    // First character.-    state, branches <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }--    brancher <- require(branches).value()-    if (brancher.matchSatisfied()) {-      fail("match satisfied")-    }-    branches <- require(branches).next()-    if (present(branches)) {-      fail("branch present")-    }--    // Second character.-    state, branches <- brancher.tryBranches('q')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (present(branches)) {-      fail("branch present")-    }-  }-}---testcase "BranchSequence match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]a"-    MatchBrancherTemplate<Char> template <--        BranchSequence<Char>$create(-            LinkedNode<MatcherTemplate<Char>>$create(MatchRange<Char>$create('w','y'),-                LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('a'),empty)))-    MatchBrancher<Char> brancher <- template.newBrancher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (brancher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<Char>> branches <- empty--    // First character.-    state, branches <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }--    brancher <- require(branches).value()-    branches <- require(branches).next()-    if (present(branches)) {-      fail("branch present")-    }--    // Second character.-    state, branches <- brancher.tryBranches('a')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }--    // The final branch should just be a record of completeness.-    if (!require(branches).value().matchSatisfied()) {-      fail("match not satisfied")-    }-    state, branches <- require(branches).value().tryBranches('a')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }--    // Reset to reuse the brancher.-    brancher <- template.newBrancher()--    // Third character.-    state, branches <- brancher.tryBranches('y')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }-  }-}---testcase "BranchSequence non-match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]a"-    MatchBrancherTemplate<Char> template <--        BranchSequence<Char>$create(-            LinkedNode<MatcherTemplate<Char>>$create(MatchRange<Char>$create('w','y'),-                LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('a'),empty)))-    MatchBrancher<Char> brancher <- template.newBrancher()--    MatchState state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<Char>> branches <- empty--    // First character.-    state, branches <- brancher.tryBranches('q')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (present(branches)) {-      fail("branch present")-    }--    // Should keep failing to match.-    state, branches <- brancher.tryBranches('x')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-  }-}---testcase "BranchSequence skip empty failed" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "a*b"-    MatchBrancherTemplate<Char> template <--        BranchSequence<Char>$create(-            LinkedNode<MatcherTemplate<Char>>$create(-                MatchBranches<Char>$create(-                    BranchRepeat<Char>$createZeroPlus(MatchSingle<Char>$create('a'))),-                LinkedNode<MatcherTemplate<Char>>$create(-                    MatchSingle<Char>$create('b'),empty)))-    MatchBrancher<Char> brancher <- template.newBrancher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (brancher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<Char>> branches <- empty--    // First character.-    state, branches <- brancher.tryBranches('b')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }-  }-}---testcase "BranchSequence fail non-empty field" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "a+b"-    MatchBrancherTemplate<Char> template <--        BranchSequence<Char>$create(-            LinkedNode<MatcherTemplate<Char>>$create(-                MatchBranches<Char>$create(-                    BranchRepeat<Char>$createOnePlus(MatchSingle<Char>$create('a'))),-                LinkedNode<MatcherTemplate<Char>>$create(-                    MatchSingle<Char>$create('b'),empty)))-    MatchBrancher<Char> brancher <- template.newBrancher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (brancher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<Char>> branches <- empty--    // First character.-    state, branches <- brancher.tryBranches('b')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (present(branches)) {-      fail("branch present")-    }-  }-}---testcase "BranchSequence branch sequence multi-match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "a*a{0,2}"-    MatchBrancherTemplate<Char> template <--        BranchSequence<Char>$create(-            LinkedNode<MatcherTemplate<Char>>$create(-                MatchBranches<Char>$create(-                    BranchRepeat<Char>$createZeroPlus(MatchSingle<Char>$create('a'))),-                LinkedNode<MatcherTemplate<Char>>$create(-                    MatchBranches<Char>$create(-                        BranchRepeat<Char>$createRange(0,2,MatchSingle<Char>$create('a'))),empty)))-    MatchBrancher<Char> brancher <- template.newBrancher()--    if (!template.matchesEmpty()) {-      fail("doesn't match empty")-    }-    if (!brancher.matchSatisfied()) {-      fail("match not satisfied")-    }--    MatchState state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<Char>> branches <- empty--    // First character.-    state, branches <- brancher.tryBranches('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!present(branches)) {-      fail("branch missing")-    }--    brancher <- require(branches).value()-    branches <- require(branches).next()-    if (!present(branches)) {-      fail("branch missing")-    }--    // TODO: This assumes that the branches are ordered from longest to shortest-    // remaining sequence.--    // Second character, branch 1.-    state, _ <- brancher.tryBranches('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }--    brancher <- require(branches).value()-    branches <- require(branches).next()-    if (present(branches)) {-      fail("branch present")-    }--    // Second character, branch 2.-    state, _ <- brancher.tryBranches('a')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-  }-}---testcase "MatchBranches match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]a"-    MatcherTemplate<Char> template <--        MatchBranches<Char>$create(-            BranchSequence<Char>$create(-                LinkedNode<MatcherTemplate<Char>>$create(MatchRange<Char>$create('w','y'),-                    LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('a'),empty))))-    Matcher<Char> matcher <- template.newMatcher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Reset to reuse the matcher.-    matcher <- template.newMatcher()--    // Third character.-    state <- matcher.tryNextMatch('y')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-  }-}---testcase "MatchBranches non-match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "[w-y]a"-    MatcherTemplate<Char> template <--        MatchBranches<Char>$create(-            BranchSequence<Char>$create(-                LinkedNode<MatcherTemplate<Char>>$create(MatchRange<Char>$create('w','y'),-                    LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('a'),empty))))-    Matcher<Char> matcher <- template.newMatcher()--    if (template.matchesEmpty()) {-      fail("matches empty")-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('x')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('q')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Should keep failing to match.-    state <- matcher.tryNextMatch('y')-    if (!(state `MatchState$equals` MatchState$matchFail())) {-      fail(state)-    }-  }-}---testcase "MatchBranches branched match" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "ab"-    MatcherTemplate<Char> templateAB <--        MatchBranches<Char>$create(-            BranchSequence<Char>$create(-                LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('a'),-                    LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('b'),empty))))-    // Pattern: "ac"-    MatcherTemplate<Char> templateAC <--        MatchBranches<Char>$create(-            BranchSequence<Char>$create(-                LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('a'),-                    LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('c'),empty))))-    // Pattern: "(ab)*ac"-    MatcherTemplate<Char> template <--        MatchBranches<Char>$create(-            BranchSequence<Char>$create(-                LinkedNode<MatcherTemplate<Char>>$create(-                    MatchBranches<Char>$create(-                        BranchRepeat<Char>$createZeroPlus(templateAB)),-                    LinkedNode<MatcherTemplate<Char>>$create(templateAC,empty))))-    Matcher<Char> matcher <- template.newMatcher()--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('c')-    if (!(state `MatchState$equals` MatchState$matchComplete())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    // Reset to reuse the matcher.-    matcher <- template.newMatcher()--    // First character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('b')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }-  }-}---testcase "MatchBranches partial repeat" {-  success Test$execute()-}--concrete Test {-  @type execute () -> ()-}--define Test {-  execute () {-    // Pattern: "(ab)*"-    MatcherTemplate<Char> template <--        MatchBranches<Char>$create(-            BranchRepeat<Char>$createZeroPlus(-                MatchBranches<Char>$create(-                    BranchSequence<Char>$create(-                        LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('a'),-                            LinkedNode<MatcherTemplate<Char>>$create(MatchSingle<Char>$create('b'),empty))))))-    Matcher<Char> matcher <- template.newMatcher()--    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }--    MatchState state <- MatchState$matchFail()--    // First character.-    state <- matcher.tryNextMatch('a')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (matcher.matchSatisfied()) {-      fail("match satisfied")-    }--    // Second character.-    state <- matcher.tryNextMatch('b')-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      fail(state)-    }-    if (!matcher.matchSatisfied()) {-      fail("match not satisfied")-    }-  }-}

@@ -1,127 +0,0 @@-concrete MatchState {-  refines Formatted-  defines Equals<MatchState>-  defines LessThan<MatchState>--  // Ordered from low to high.--  @type matchFail     () -> (MatchState) // Matching has failed.-  @type matchComplete () -> (MatchState) // End of the pattern.-  @type matchContinue () -> (MatchState) // Matching must continue.-}--@value interface Matcher<#c|> {-  // Returns true if the pattern is complete without additional data.-  matchSatisfied () -> (Bool)--  // This can be called as long as it returns matchContinue(). The matcher does-  // not branch; each call updates it with the next data point in the input.-  //-  // Returns:-  // - matchFail(): The pattern cannot be completed.-  // - matchContinue(): Matching can continue; check matchSatisfied() to see if-  //                    more data is required to complete the pattern.-  // - matchComplete(): The pattern has been completed and cannot match any-  //                    additional data.-  tryNextMatch (#c) -> (MatchState)-}--@value interface MatcherTemplate<#c|> {-  // Returns true if the pattern can match an empty sequence.-  matchesEmpty () -> (Bool)-  newMatcher () -> (Matcher<#c>)-}--@value interface MatchBrancher<#c|> {-  // Returns true if the pattern is complete without additional data.-  matchSatisfied () -> (Bool)--  // NOTE: Calling this invalidates the MatchBrancher. Subsequent calls should-  // be done against the returned branches.-  // Returns:-  // - state: The highest state of the branches checked.-  // - branches: All branches with a status of matchContinue().-  tryBranches (#c) -> (MatchState /*state*/,-                       optional ReadSequence<MatchBrancher<#c>> /*branches*/)-}--@value interface MatchBrancherTemplate<#c|> {-  // Returns true if the pattern can match an empty sequence.-  matchesEmpty () -> (Bool)-  newBrancher () -> (MatchBrancher<#c>)-}--concrete MatchSingle<#c> {-  #c defines Equals<#c>--  refines MatcherTemplate<#c>--  @type create (#c) -> (MatchSingle<#c>)-}--concrete MatchRange<#c> {-  #c defines LessThan<#c>--  refines MatcherTemplate<#c>--  @type create (#c,#c) -> (MatchRange<#c>)-}--concrete MatchAny {-  refines MatcherTemplate<any>--  @type create () -> (MatchAny)-}--concrete MatchEmpty {-  refines MatcherTemplate<any>--  @type create () -> (MatchEmpty)-}--concrete MatchRepeat<#c> {-  refines MatcherTemplate<#c>--  @type createZeroPlus (MatcherTemplate<#c>) -> (MatchRepeat<#c>)-  @type createOnePlus (MatcherTemplate<#c>) -> (MatchRepeat<#c>)-  @type createRange (Int,Int,MatcherTemplate<#c>) -> (MatchRepeat<#c>)-}--concrete MatchChoices<#c> {-  refines MatcherTemplate<#c>--  @type create (optional ReadSequence<MatcherTemplate<#c>>) -> (MatchChoices<#c>)-}--concrete MatchBranches<#c> {-  refines MatcherTemplate<#c>--  @type create (MatchBrancherTemplate<#c>) -> (MatcherTemplate<#c>)-}--concrete BranchRepeat<#c> {-  refines MatchBrancherTemplate<#c>--  @type createZeroPlus (MatcherTemplate<#c>) -> (BranchRepeat<#c>)-  @type createOnePlus (MatcherTemplate<#c>) -> (BranchRepeat<#c>)-  @type createRange (Int,Int,MatcherTemplate<#c>) -> (BranchRepeat<#c>)-}--concrete BranchSequence<#c> {-  refines MatchBrancherTemplate<#c>--  @type create (optional ReadSequence<MatcherTemplate<#c>>) -> (BranchSequence<#c>)-}--@value interface ReadSequence<|#c> {-  value () -> (#c)-  next () -> (optional ReadSequence<#c>)-}--concrete LinkedNode<#x> {-  refines ReadSequence<#x>--  @type create (#x,optional ReadSequence<#x>) -> (ReadSequence<#x>)-  @type concatSequences (optional ReadSequence<#x>,optional ReadSequence<#x>) ->-                        (optional ReadSequence<#x>)-}

@@ -1,724 +0,0 @@-define MatchState {-  @value Int enum-  @value String name-  @category MatchState matchFailVal     <- MatchState{ 0, "matchFail" }-  @category MatchState matchCompleteVal <- MatchState{ 1, "matchComplete" }-  @category MatchState matchContinueVal <- MatchState{ 2, "matchContinue" }--  formatted () {-    return "MatchState$" + name + "()"-  }--  equals (x,y) {-    return x.getEnum() == y.getEnum()-  }--  lessThan (x,y) {-    return x.getEnum() < y.getEnum()-  }--  matchFail () {-    return matchFailVal-  }--  matchComplete () {-    return matchCompleteVal-  }--  matchContinue () {-    return matchContinueVal-  }--  @value getEnum () -> (Int)-  getEnum () {-    return enum-  }-}--define MatchSingle {-  @value #c match--  create (match) {-    return MatchSingle<#c>{ match }-  }--  matchesEmpty () {-    return false-  }--  newMatcher () {-    return MatchSingleMatcher<#c>$create(match)-  }-}--concrete MatchSingleMatcher<#c> {-  #c defines Equals<#c>--  refines Matcher<#c>--  @type create (#c) -> (MatchSingleMatcher<#c>)-}--define MatchSingleMatcher {-  @value #c match-  @value MatchState state--  create (match) {-    return MatchSingleMatcher<#c>{ match, MatchState$matchContinue() }-  }--  matchSatisfied () {-    return state `MatchState$equals` MatchState$matchComplete()-  }--  tryNextMatch (data) {-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      return (state <- MatchState$matchFail())-    }-    if (data `#c$equals` match) {-      return (state <- MatchState$matchComplete())-    } else {-      return (state <- MatchState$matchFail())-    }-  }-}--define MatchRange {-  @value #c minMatch-  @value #c maxMatch--  create (minMatch,maxMatch) {-    return MatchRange<#c>{ minMatch, maxMatch }-  }--  matchesEmpty () {-    return false-  }--  newMatcher () {-    return MatchRangeMatcher<#c>$create(minMatch,maxMatch)-  }-}--concrete MatchRangeMatcher<#c> {-  #c defines LessThan<#c>--  refines Matcher<#c>--  @type create (#c,#c) -> (MatchRangeMatcher<#c>)-}--define MatchRangeMatcher {-  @value #c minMatch-  @value #c maxMatch-  @value MatchState state--  create (minMatch,maxMatch) {-    return MatchRangeMatcher<#c>{ minMatch, maxMatch, MatchState$matchContinue() }-  }--  matchSatisfied () {-    return state `MatchState$equals` MatchState$matchComplete()-  }--  tryNextMatch (data) {-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      return (state <- MatchState$matchFail())-    }-    if (!(data `#c$lessThan` minMatch) && !(maxMatch `#c$lessThan` data)) {-      return (state <- MatchState$matchComplete())-    } else {-      return (state <- MatchState$matchFail())-    }-  }-}--define MatchAny {-  create () {-    return MatchAny{ }-  }--  matchesEmpty () {-    return false-  }--  newMatcher () {-    return MatchAnyMatcher$create()-  }-}--concrete MatchAnyMatcher {-  refines Matcher<any>--  @type create () -> (MatchAnyMatcher)-}--define MatchAnyMatcher {-  @value MatchState state--  create () {-    return MatchAnyMatcher{ MatchState$matchContinue() }-  }--  matchSatisfied () {-    return state `MatchState$equals` MatchState$matchComplete()-  }--  tryNextMatch (data) {-    if (!(state `MatchState$equals` MatchState$matchContinue())) {-      return (state <- MatchState$matchFail())-    }-    return (state <- MatchState$matchComplete())-  }-}--define MatchEmpty {-  create () {-    return MatchEmpty{ }-  }--  matchesEmpty () {-    return true-  }--  newMatcher () {-    return MatchEmptyMatcher$create()-  }-}--concrete MatchEmptyMatcher {-  refines Matcher<any>--  @type create () -> (MatchEmptyMatcher)-}--define MatchEmptyMatcher {-  @value Bool failed--  create () {-    return MatchEmptyMatcher{ false }-  }--  matchSatisfied () {-    return !failed-  }--  tryNextMatch (data) {-    failed <- true-    return MatchState$matchFail()-  }-}--define MatchRepeat {-  @value MatcherTemplate<#c> template-  @value Int minCount-  @value Int maxCount--  createZeroPlus (template) {-    return createRange(0,0,template)-  }--  createOnePlus (template) {-    return createRange(1,0,template)-  }--  createRange (minCount,maxCount,template) {-    return MatchRepeat<#c>{ template, minCount, maxCount }-  }--  matchesEmpty () {-    return minCount <= 0 || template.matchesEmpty()-  }--  newMatcher () {-    return MatchRepeatMatcher<#c>$create(minCount,maxCount,template)-  }-}--concrete MatchRepeatMatcher<#c> {-  refines Matcher<#c>--  @type create (Int,Int,MatcherTemplate<#c>) -> (MatchRepeatMatcher<#c>)-}--define MatchRepeatMatcher {-  @value MatcherTemplate<#c> template-  @value Matcher<#c> matcher-  @value Int minCount-  @value Int maxCount // 0 means unlimited.-  @value Int repetitionCount-  @value MatchState lastState--  create (minCount,maxCount,template) {-    return MatchRepeatMatcher<#c>{ template, template.newMatcher(), minCount,-                                   maxCount, 0, MatchState$matchComplete() }-  }--  matchSatisfied () {-    if (lastState `MatchState$equals` MatchState$matchFail()) {-      return false-    }-    if (lastState `MatchState$equals` MatchState$matchContinue() &&-        (repetitionCount+1 >= minCount || template.matchesEmpty()) &&-        matcher.matchSatisfied()) {-      // The rest of the current repetition can be ignored.-      return true-    }-    if (lastState `MatchState$equals` MatchState$matchComplete() &&-        (repetitionCount >= minCount || template.matchesEmpty())) {-      return true-    }-    return false-  }--  tryNextMatch (data) (state) {-    if (atMax() || lastState `MatchState$equals` MatchState$matchFail()) {-      return MatchState$matchFail()-    }-    Bool canSkip <- matcher.matchSatisfied()-    state <- matcher.tryNextMatch(data)-    if (state `MatchState$equals` MatchState$matchFail() &&-        lastState `MatchState$equals` MatchState$matchContinue() && canSkip) {-      // Handle the case where an optional end to the pattern can be skipped.-      \ incrementMatch()-      \ startRepeat()-      state <- matcher.tryNextMatch(data)-    }-    lastState <- state-    if (state `MatchState$equals` MatchState$matchComplete()) {-      \ incrementMatch()-      \ startRepeat()-      if (atMax()) {-        state <- MatchState$matchComplete()-      } else {-        state <- MatchState$matchContinue()-      }-    }-  }--  @value incrementMatch () -> ()-  incrementMatch () {-    repetitionCount <- repetitionCount+1-  }--  @value atMax () -> (Bool)-  atMax () {-    return maxCount > 0 && repetitionCount >= maxCount-  }--  @value startRepeat () -> ()-  startRepeat () {-    matcher <- template.newMatcher()-  }-}--define MatchChoices {-  @value optional ReadSequence<MatcherTemplate<#c>> choices--  create (choices) {-    return MatchChoices<#c>{ choices }-  }--  matchesEmpty () {-    scoped {-      optional ReadSequence<MatcherTemplate<#c>> current <- choices-    } in while (present(current)) {-      if (require(current).value().matchesEmpty()) {-        return true-      }-    } update {-      current <- require(current).next()-    }-    return false-  }--  newMatcher () {-    return MatchChoicesMatcher<#c>$create(recursiveNewMatcher(choices))-  }--  @type recursiveNewMatcher (optional ReadSequence<MatcherTemplate<#c>>) ->-                            (optional ReadSequence<Matcher<#c>>)-  recursiveNewMatcher (choices) {-    if (!present(choices)) {-      return empty-    }-    return LinkedNode<Matcher<#c>>$create(require(choices).value().newMatcher(),-                                          recursiveNewMatcher(require(choices).next()))-  }-}--concrete MatchChoicesMatcher<#c> {-  refines Matcher<#c>--  @type create (optional ReadSequence<Matcher<#c>>) -> (MatchChoicesMatcher<#c>)-}--define MatchChoicesMatcher {-  @value optional ReadSequence<Matcher<#c>> choices--  create (choices) {-    return MatchChoicesMatcher<#c>{ choices }-  }--  matchSatisfied () {-    scoped {-      optional ReadSequence<Matcher<#c>> current <- choices-    } in while (present(current)) {-      if (require(current).value().matchSatisfied()) {-        return true-      }-    } update {-      current <- require(current).next()-    }-    return false-  }--  tryNextMatch (data) (state) {-    state <- MatchState$matchFail()-    scoped {-      optional ReadSequence<Matcher<#c>> current <- choices-    } in while (present(current)) {-      // NOTE: Failing matchers are left in for simplicity, under the assumption-      // that they will keep failing.-      MatchState state2 <- require(current).value().tryNextMatch(data)-      if (state `MatchState$lessThan` state2) {-        state <- state2-      }-    } update {-      current <- require(current).next()-    }-  }-}--define MatchBranches {-  @value MatchBrancherTemplate<#c> template--  create (template) {-    return MatchBranches<#c>{ template }-  }--  matchesEmpty () {-    return template.matchesEmpty()-  }--  newMatcher () {-    return MatchBranchesMatcher<#c>$create(template.newBrancher())-  }-}--concrete MatchBranchesMatcher<#c> {-  refines Matcher<#c>--  @type create (MatchBrancher<#c>) -> (MatchBranchesMatcher<#c>)-}--define MatchBranchesMatcher {-  @value optional ReadSequence<MatchBrancher<#c>> branches-  @value Bool complete--  create (brancher) {-    return MatchBranchesMatcher<#c>{ LinkedNode<MatchBrancher<#c>>$create(brancher,empty), false }-  }--  matchSatisfied () {-    if (complete) {-      return true-    }-    scoped {-      optional ReadSequence<MatchBrancher<#c>> current <- branches-    } in while (present(current)) {-      if (require(current).value().matchSatisfied()) {-        return true-      }-    } update {-      current <- require(current).next()-    }-    return false-  }--  tryNextMatch (data) (state) {-    state <- MatchState$matchFail()-    optional ReadSequence<MatchBrancher<#c>> current <- branches-    branches <- empty-    complete <- false-    scoped {-    } in while(present(current)) {-      MatchState state2, optional ReadSequence<MatchBrancher<#c>> branches2 <--          require(current).value().tryBranches(data)-      if (state2 `MatchState$equals` MatchState$matchComplete()) {-        complete <- true-      }-      if (state `MatchState$lessThan` state2) {-        state <- state2-      }-      branches <- LinkedNode<MatchBrancher<#c>>$concatSequences(branches2,branches)-    } update {-      current <- require(current).next()-    }-  }-}--concrete BranchRepeatMatcher<#c> {-  refines MatchBrancher<#c>--  @type create (Int,Int,MatcherTemplate<#c>) -> (BranchRepeatMatcher<#c>)-  @value tryBranches (#c) -> (MatchState,optional ReadSequence<BranchRepeatMatcher<#c>>)-}--define BranchRepeatMatcher {-  @value MatcherTemplate<#c> template-  @value Matcher<#c> matcher-  @value Int minCount-  @value Int maxCount // 0 means unlimited.-  @value Int repetitionCount-  @value MatchState lastState--  create (minCount,maxCount,template) {-    return BranchRepeatMatcher<#c>{ template, template.newMatcher(), minCount,-                                    maxCount, 0, MatchState$matchComplete() }-  }--  matchSatisfied () {-    if (lastState `MatchState$equals` MatchState$matchFail()) {-      return false-    }-    if (lastState `MatchState$equals` MatchState$matchContinue() &&-        (repetitionCount+1 >= minCount || template.matchesEmpty()) &&-        matcher.matchSatisfied()) {-      // The rest of the current repetition can be ignored.-      return true-    }-    if (lastState `MatchState$equals` MatchState$matchComplete() &&-        (repetitionCount >= minCount || template.matchesEmpty())) {-      return true-    }-    return false-  }--  tryBranches (data) (state,branch) {-    state <- MatchState$matchFail()-    branch <- empty-    if (atMax() || lastState `MatchState$equals` MatchState$matchFail()) {-      return _-    }-    if (lastState `MatchState$equals` MatchState$matchContinue()) {-      // Handle a possible single branch.-      Bool canSkip <- matcher.matchSatisfied()-      state <- matcher.tryNextMatch(data)-      if (canSkip) {-        if (state `MatchState$equals` MatchState$matchContinue()) {-          // Add a branch for the optional suffix.-          branch <- LinkedNode<BranchRepeatMatcher<#c>>$create(-              BranchRepeatMatcher<#c>{ template, matcher, minCount,-                                       maxCount, repetitionCount,-                                       MatchState$matchContinue() },empty)-        }-        // Continue, skipping over the optional suffix.-        \ incrementMatch()-        \ startRepeat()-        if (atMax()) {-          // Skipping the branch puts us at the max.-          return _-        }-        state <- matcher.tryNextMatch(data)-      }-    } else {-      // Branching is not possible.-      state <- matcher.tryNextMatch(data)-    }-    lastState <- state-    if (state `MatchState$equals` MatchState$matchComplete()) {-      \ incrementMatch()-      \ startRepeat()-      if (!atMax()) {-        branch <- LinkedNode<BranchRepeatMatcher<#c>>$create(self,branch)-      }-    } elif (state `MatchState$equals` MatchState$matchContinue()) {-      branch <- LinkedNode<BranchRepeatMatcher<#c>>$create(self,branch)-    }-    if (present(branch)) {-      state <- MatchState$matchContinue()-    }-  }--  @value incrementMatch () -> ()-  incrementMatch () {-    repetitionCount <- repetitionCount+1-  }--  @value atMax () -> (Bool)-  atMax () {-    return maxCount > 0 && repetitionCount >= maxCount-  }--  @value startRepeat () -> ()-  startRepeat () {-    matcher <- template.newMatcher()-  }-}--define BranchSequence {-  @value optional ReadSequence<MatcherTemplate<#c>> sequence--  create (sequence) {-    return BranchSequence<#c>{ sequence }-  }--  matchesEmpty () {-    scoped {-      optional ReadSequence<MatcherTemplate<#c>> current <- sequence-    } in while (present(current)) {-      if (!require(current).value().matchesEmpty()) {-        return false-      }-    } update {-      current <- require(current).next()-    }-    return true-  }--  newBrancher () {-    return BranchSequenceMatcher<#c>$create(sequence)-  }-}--concrete BranchSequenceMatcher<#c> {-  refines MatchBrancher<#c>--  @type create (optional ReadSequence<MatcherTemplate<#c>>) -> (BranchSequenceMatcher<#c>)-  @value tryBranches (#c) -> (MatchState,optional ReadSequence<BranchSequenceMatcher<#c>>)-}--define BranchSequenceMatcher {-  @value optional Matcher<#c> continued-  @value optional ReadSequence<MatcherTemplate<#c>> sequence-  @value Bool consumed--  create (sequence) {-    return BranchSequenceMatcher<#c>{ empty, sequence, false }-  }--  matchSatisfied () {-    if (consumed) {-      return false-    }-    if (present(continued) && !require(continued).matchSatisfied()) {-      return false-    }-    scoped {-      optional ReadSequence<MatcherTemplate<#c>> current <- sequence-    } in while (present(current)) {-      if (!require(current).value().matchesEmpty()) {-        return false-      }-    } update {-      current <- require(current).next()-    }-    return true-  }--  tryBranches (data) {-    if (consumed) {-      return MatchState$matchFail(), empty-    }-    consumed <- true-    return recursiveBranch(data,continued,sequence)-  }--  @type recursiveBranch (#c,optional Matcher<#c>,optional ReadSequence<MatcherTemplate<#c>>) ->-                        (MatchState,optional ReadSequence<BranchSequenceMatcher<#c>>)-  recursiveBranch (data,continued,sequence) (state,branch) {-    state <- MatchState$matchFail()-    branch <- empty-    if (!present(continued) && !present(sequence)) {-      return _-    }-    optional Matcher<#c> continued2 <- continued-    optional ReadSequence<MatcherTemplate<#c>> sequence2 <- sequence-    if (!present(continued2)) {-      continued2 <- require(sequence2).value().newMatcher()-      sequence2 <- require(sequence2).next()-    }-    if (require(continued2).matchSatisfied()) {-      MatchState state2, branch <- recursiveBranch(data,empty,sequence2)-      if (state `MatchState$lessThan` state2) {-        state <- state2-      }-    }-    MatchState state2 <- require(continued2).tryNextMatch(data)-    if (state `MatchState$lessThan` state2) {-      state <- state2-    }-    if (state2 `MatchState$equals` MatchState$matchComplete()) {-      if (present(sequence2)) {-        // Add a branch to continue this sequence.-        branch <- LinkedNode<BranchSequenceMatcher<#c>>$create(-            BranchSequenceMatcher<#c>{ empty, sequence2, false },branch)-        state <- MatchState$matchContinue()-      } else {-        // Add a branch to serve as a record of completeness. It will fail to-        // match anything, but matchSatisfied() will return true.-        branch <- LinkedNode<BranchSequenceMatcher<#c>>$create(-            BranchSequenceMatcher<#c>{ empty, empty, false },branch)-      }-    } elif (state `MatchState$equals` MatchState$matchContinue()) {-        // Add a branch to continue this sequence.-        branch <- LinkedNode<BranchSequenceMatcher<#c>>$create(-            BranchSequenceMatcher<#c>{ continued2, sequence2, false },branch)-    }-  }-}--define BranchRepeat {-  @value MatcherTemplate<#c> template-  @value Int minCount-  @value Int maxCount--  createZeroPlus (template) {-    return createRange(0,0,template)-  }--  createOnePlus (template) {-    return createRange(1,0,template)-  }--  createRange (minCount,maxCount,template) {-    return BranchRepeat<#c>{ template, minCount, maxCount }-  }--  matchesEmpty () {-    return minCount <= 0 || template.matchesEmpty()-  }--  newBrancher () {-    return BranchRepeatMatcher<#c>$create(minCount,maxCount,template)-  }-}--define LinkedNode {-  @value optional ReadSequence<#x> nextNode-  @value #x data--  create (data,nextNode) {-    return LinkedNode<#x>{ nextNode, data }-  }--  concatSequences (head1,head2) {-    if (!present(head2)) {-      return head1-    } elif (present(head1)) {-      return LinkedNode<#x>$create(require(head1).value(),-                                   concatSequences(require(head1).next(),head2))-    } else {-      return head2-    }-  }--  value () {-    return data-  }--  next () {-    return nextNode-  }-}

@@ -114,7 +114,8 @@ } struct Value_RawFileReader : public TypeValue {   Value_RawFileReader(Type_RawFileReader& p, const ParamTuple& params, const ValueTuple& args)-    : parent(p), file(new std::ifstream(args.At(0)->AsString(), std::ios::in | std::ios::binary)) {}+    : parent(p), filename(args.At(0)->AsString()),+    file(new std::ifstream(filename, std::ios::in | std::ios::binary)) {}    ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {     using CallType = ReturnTuple(Value_RawFileReader::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);@@ -156,7 +157,9 @@   Type_RawFileReader& parent;    std::mutex mutex;+  const std::string filename;   R<std::istream> file;+  CAPTURE_CREATION }; S<TypeValue> CreateValue(Type_RawFileReader& parent, const ParamTuple& params, const ValueTuple& args) {   return S_get(new Value_RawFileReader(parent, params, args));@@ -199,10 +202,14 @@  ReturnTuple Value_RawFileReader::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;

@@ -114,7 +114,8 @@ } struct Value_RawFileWriter : public TypeValue {   Value_RawFileWriter(Type_RawFileWriter& p, const ParamTuple& params, const ValueTuple& args)-    : parent(p), file(new std::ofstream(args.At(0)->AsString(), std::ios::out | std::ios::binary | std::ios::trunc | std::ios::ate)) {}+    : parent(p), filename(args.At(0)->AsString()),+    file(new std::ofstream(filename, std::ios::out | std::ios::binary | std::ios::trunc | std::ios::ate)) {}    ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {     using CallType = ReturnTuple(Value_RawFileWriter::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);@@ -154,7 +155,9 @@   Type_RawFileWriter& parent;    std::mutex mutex;+  const std::string filename;   R<std::ostream> file;+  CAPTURE_CREATION }; S<TypeValue> CreateValue(Type_RawFileWriter& parent, const ParamTuple& params, const ValueTuple& args) {   return S_get(new Value_RawFileWriter(parent, params, args));@@ -188,8 +191,12 @@ } ReturnTuple Value_RawFileWriter::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());

@@ -103,17 +103,24 @@     if (!present(reader.getFileError())) {       fail("expected file error")     }+  }+} -    String data <- reader.readBlock(10)-    if (data != "") {-      fail("\"" + data + "\"")-    }-    if (!present(reader.getFileError())) {-      fail("expected file error")-    }-    if (!reader.pastEnd()) {-      fail("more data in file")-    }+concrete Test {+  @type run () -> ()+}+++testcase "read missing file crash" {+  crash Test$run()+  require "do-not-create-this-file"+  require "RawFileReader .*originally created"+}++define Test {+  run () {+    RawFileReader reader <- RawFileReader$open("do-not-create-this-file")+    \ reader.readBlock(0)   } } @@ -128,10 +135,30 @@  define Test {   run () {-    RawFileWriter writer <- RawFileWriter$open("/")+    RawFileWriter writer <- RawFileWriter$open("testfile")+    \ writer.freeResource()     if (!present(writer.getFileError())) {       fail("expected file error")     }+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "unwritable file crash" {+  crash Test$run()+  require "testfile"+  require "RawFileWriter .*originally created"+}++define Test {+  run () {+    RawFileWriter writer <- RawFileWriter$open("testfile")+    \ writer.freeResource()+    \ writer.writeBlock("")   } } 

@@ -1,5 +1,14 @@ root: ".." path: "util"+expression_map: [+  expression_macro {+    name: BLOCK_READ_SIZE+    expression: \x1000+  }+]+private_deps: [+  "../../tests"+] extra_files: [   category_source {     source: "util/Category_Argv.cpp"

@@ -217,3 +217,143 @@ concrete Test {   @type run () -> () }+++testcase "TextReader readAll" {+  success Test$run()+}++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+  }+}++define Test {+  run () {+    String allContents <- TextReader$readAll(FakeFile$create())+    \ Testing$check<String>(allContents,"this is a partial line\nwith some more data\nand\nmore lines\nunfinished")+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "ErrorOr value" {+  success Test$run()+}++define Test {+  run () {+    ErrorOr<Int> value <- ErrorOr$$value<Int>(10)+    if (value.isError()) {+      fail("Failed")+    }+    \ Testing$check<Int>(value.getValue(),10)+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "ErrorOr getError() crashes with value" {+  crash Test$run()+  require "empty"+}++define Test {+  run () {+    ErrorOr<Int> value <- ErrorOr$$value<Int>(10)+    \ value.getError()+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "ErrorOr error" {+  success Test$run()+}++define Test {+  run () {+    ErrorOr<String> value <- ErrorOr$$error("error message")+    if (!value.isError()) {+      fail("Failed")+    }+    \ Testing$check<String>(value.getError().formatted(),"error message")+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "ErrorOr getValue() crashes with error" {+  crash Test$run()+  require "error message"+}++define Test {+  run () {+    ErrorOr<String> value <- ErrorOr$$error("error message")+    \ value.getValue()+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "ErrorOr convert error" {+  success Test$run()+}++define Test {+  run () {+    scoped {+      ErrorOr<String> error <- ErrorOr$$error("error message")+    } in ErrorOr<Int> value <- error.convertError()+    \ Testing$check<String>(value.getError().formatted(),"error message")+  }+}++concrete Test {+  @type run () -> ()+}

@@ -18,6 +18,15 @@  // 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) }@@ -88,6 +97,18 @@  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>) }

@@ -16,6 +16,26 @@  // 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@@ -99,6 +119,14 @@     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()@@ -108,8 +136,7 @@             buffer <- ""           } in return buffer         } else {-          // TODO: Maybe the block size should be a factory argument.-          buffer <- buffer+reader.readBlock(\x100)+          buffer <- buffer+reader.readBlock($ExprLookup[BLOCK_READ_SIZE]$)         }       } else {         return takeLine(newline)@@ -143,5 +170,38 @@     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 }   } }

@@ -28,9 +28,11 @@ ) where  import Data.List (nub)+import Text.Parsec (SourcePos)  import Cli.CompileOptions import Config.Programs (VersionHash)+import Types.Procedure (Expression) import Types.TypeCategory (Namespace) import Types.TypeInstance (CategoryName) @@ -91,10 +93,23 @@   ModuleConfig {     rmRoot :: FilePath,     rmPath :: FilePath,+    rmExprMap :: [(String,Expression SourcePos)],     rmPublicDeps :: [FilePath],     rmPrivateDeps :: [FilePath],     rmExtraFiles :: [ExtraSource],     rmExtraPaths :: [FilePath],     rmMode :: CompileMode   }-  deriving (Eq,Show)+  deriving (Show)++instance Eq ModuleConfig where+  (ModuleConfig pA dA _ isA is2A esA epA mA) == (ModuleConfig pB dB _ isB is2B esB epB mB) =+    all id [+        pA == pB,+        dA == dB,+        isA == isB,+        is2A == is2B,+        esA == esB,+        epA == epB,+        mA == mB+      ]

@@ -33,6 +33,7 @@ import System.Posix.Temp (mkstemps) import System.IO import Text.Parsec (SourcePos)+import qualified Data.Map as Map import qualified Data.Set as Set  import Base.CompileError@@ -41,6 +42,7 @@ import Cli.ProcessMetadata import Cli.TestRunner -- Not safe, due to Text.Regex.TDFA. import Compilation.CompileInfo+import Compilation.ProcedureContext (ExprMap) import CompilerCxx.Category import CompilerCxx.Naming import Config.LoadConfig@@ -58,6 +60,7 @@   ModuleSpec {     msRoot :: FilePath,     msPath :: FilePath,+    msExprMap :: ExprMap SourcePos,     msPublicDeps :: [FilePath],     msPrivateDeps :: [FilePath],     msPublicFiles :: [FilePath],@@ -75,20 +78,24 @@     ltRoot :: FilePath,     ltPath :: FilePath,     ltMetadata :: CompileMetadata,+    ltExprMap :: ExprMap SourcePos,     ltPublicDeps :: [CompileMetadata],     ltPrivateDeps :: [CompileMetadata]   }   deriving (Show)  compileModule :: ModuleSpec -> IO ()-compileModule (ModuleSpec p d is is2 ps xs ts es ep m f) = do+compileModule (ModuleSpec p d em is is2 ps xs ts es ep m f) = do   (backend,resolver) <- loadConfig   let hash = getCompilerHash backend   as  <- fmap fixPaths $ sequence $ map (resolveModule resolver (p </> d)) is   as2 <- fmap fixPaths $ sequence $ map (resolveModule resolver (p </> d)) is2-  (fr1,deps1) <- loadPublicDeps hash as+  let ca0 = Map.empty+  (fr1,deps1) <- loadPublicDeps hash ca0 as+  let ca1 = ca0 `Map.union` mapMetadata deps1   checkAllowedStale fr1 f-  (fr2,deps2) <- loadPublicDeps hash as2+  (fr2,deps2) <- loadPublicDeps hash ca1 as2+  let ca2 = ca1 `Map.union` mapMetadata deps2   checkAllowedStale fr2 f   base <- resolveBaseModule resolver   actual <- resolveModule resolver p d@@ -97,12 +104,12 @@   deps1' <- if isBase                then return deps1                else do-                 (fr3,bpDeps) <- loadPublicDeps hash [base]+                 (fr3,bpDeps) <- loadPublicDeps hash ca2 [base]                  checkAllowedStale fr3 f                  return $ bpDeps ++ deps1   ns0 <- createPublicNamespace p d   let ex = concat $ map getSourceCategories es-  cm <- loadLanguageModule p ns0 ex ps deps1' deps2+  cm <- loadLanguageModule p ns0 ex em ps deps1' deps2   xa <- fmap collectAllOrErrorM $ sequence $ map (loadPrivateSource p) xs   let fs = compileAll cm xa   eraseCachedData (p </> d)@@ -243,7 +250,7 @@           hPutStr h $ concat $ map (++ "\n") content           hClose h           base <- resolveBaseModule r-          (fr,deps2)  <- loadPrivateDeps (getCompilerHash b) deps+          (fr,deps2)  <- loadPrivateDeps (getCompilerHash b) (mapMetadata deps) deps           checkAllowedStale fr f           let lf' = lf ++ getLinkFlagsForDeps deps2           let paths' = fixPaths $ paths ++ base:(getIncludePathsForDeps deps)@@ -264,7 +271,7 @@ createModuleTemplates p d deps1 deps2 = do   ns0 <- createPublicNamespace p d   (ps,xs,_) <- findSourceFiles p d-  cm <- fmap (fmap fst) $ loadLanguageModule p ns0 [] ps deps1 deps2+  cm <- fmap (fmap fst) $ loadLanguageModule p ns0 [] Map.empty ps deps1 deps2   xs' <- zipWithContents p xs   let ts = createTemplates cm xs'   if isCompileError ts@@ -277,7 +284,7 @@         formatWarnings ts         sequence_ $ map writeTemplate $ getCompileSuccess ts where   createTemplates cm xs = do-    (LanguageModule _ _ _ cs0 ps0 ts0 cs1 ps1 ts1 _) <- cm+    (LanguageModule _ _ _ cs0 ps0 ts0 cs1 ps1 ts1 _ _) <- cm     ds <- collectAllOrErrorM $ map parseInternalSource xs     let ds2 = concat $ map (\(_,_,d2) -> d2) ds     tm <- foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1,ts0,ts1]@@ -295,12 +302,12 @@           writeFile n' $ concat $ map (++ "\n") content  runModuleTests :: CompilerBackend b => b -> FilePath -> [FilePath] -> LoadedTests -> IO [((Int,Int),CompileInfo ())]-runModuleTests b base tp (LoadedTests p d m deps1 deps2) = do+runModuleTests b base tp (LoadedTests p d m em deps1 deps2) = do   let paths = base:(getIncludePathsForDeps deps1)   mapM_ showSkipped $ filter (not . isTestAllowed) $ cmTestFiles m   ts' <- zipWithContents p $ map (d </>) $ filter isTestAllowed $ cmTestFiles m   path <- canonicalizePath (p </> d)-  cm <- fmap (fmap fst) $ loadLanguageModule path NoNamespace [] [] deps1 []+  cm <- fmap (fmap fst) $ loadLanguageModule path NoNamespace [] em [] deps1 []   if isCompileError cm       then return [((0,0),cm >> return ())]       else sequence $ map (runSingleTest b (getCompileSuccess cm) path paths (m:deps2)) ts' where@@ -333,17 +340,19 @@     let testing = any isTestsOnly pragmas     return $ PrivateSource ns testing cs' ds -loadLanguageModule :: CompileErrorM m => FilePath -> Namespace -> [CategoryName] ->-  [FilePath] -> [CompileMetadata] -> [CompileMetadata] ->-  IO (m (LanguageModule SourcePos,([CategoryName],[CategoryName])))-loadLanguageModule p ns2 ex fs deps1 deps2 = do+loadLanguageModule :: CompileErrorM m => FilePath -> Namespace ->+  [CategoryName] -> ExprMap SourcePos -> [FilePath] -> [CompileMetadata] ->+  [CompileMetadata] -> IO (m (LanguageModule SourcePos,([CategoryName],[CategoryName])))+loadLanguageModule p ns2 ex em fs deps1 deps2 = do+  let public = Set.fromList $ map cmPath deps1+  let deps2' = filter (\cm -> not $ cmPath cm `Set.member` public) deps2+  let ns0 = filter (not . isNoNamespace) $ getNamespacesForDeps deps1+  let ns1 = filter (not . isNoNamespace) $ getNamespacesForDeps deps2'   m0 <- fmap merge $ sequence $ map processAll deps1-  m1 <- fmap merge $ sequence $ map processAll deps2+  m1 <- fmap merge $ sequence $ map processAll deps2'   m2 <- loadAllPublic "" fs-  return $ construct m0 m1 m2 where-    ns0 = filter (not . isNoNamespace) $ getNamespacesForDeps deps1-    ns1 = filter (not . isNoNamespace) $ getNamespacesForDeps deps2-    construct m0 m1 m2 = do+  return $ construct m0 m1 m2 ns0 ns1 where+    construct m0 m1 m2 ns0 ns1 = do       (ps0,_,tsA0,_)      <- m0       (ps1,_,tsA1,_)      <- m1       (ps2,xs2,tsA2,tsB2) <- m2@@ -357,7 +366,8 @@           lmPublicLocal = map (setCategoryNamespace ns2) ps2,           lmPrivateLocal = map (setCategoryNamespace ns2) xs2,           lmTestingLocal = map (setCategoryNamespace ns2) $ tsA2 ++ tsB2,-          lmExternal = ex+          lmExternal = ex,+          lmExprMap = em         }       return (cm,(map getCategoryName $ ps2++tsA2,map getCategoryName $ xs2++tsB2))     loadPublic p2 p3 = parsePublicSource p3 >>= return . uncurry (partition p2)

@@ -29,6 +29,7 @@ import System.Exit import System.IO import Text.Regex.TDFA -- Not safe!+import qualified Data.Map as Map  import Base.CompileError import Cli.CompileMetadata@@ -103,7 +104,7 @@   exitSuccess where     showDeps p = do       p' <- canonicalizePath p-      m <- loadMetadata p'+      m <- loadMetadata Map.empty p'       hPutStrLn stdout $ show p'       mapM_ showDep (cmObjectFiles m)     showDep (CategoryObjectFile c ds _) = do

@@ -31,9 +31,12 @@ import Cli.CompileOptions import Config.Programs (VersionHash(..)) import Parser.Common+import Parser.Procedure ()+import Parser.Pragma (parseMacroName) import Parser.TypeCategory () import Parser.TypeInstance () import Text.Regex.TDFA -- Not safe!+import Types.Procedure (Expression) import Types.TypeCategory (FunctionName(..),Namespace(..)) import Types.TypeInstance (CategoryName(..)) @@ -265,20 +268,26 @@  instance ConfigFormat ModuleConfig where   readConfig = do-      p <-   parseOptional "root:"          "" parseQuoted-      d <-   parseRequired "path:"             parseQuoted-      is <-  parseOptional "public_deps:"   [] (parseList parseQuoted)-      is2 <- parseOptional "private_deps:"  [] (parseList parseQuoted)-      es <-  parseOptional "extra_files:"   [] (parseList readConfig)-      ep <-  parseOptional "include_paths:" [] (parseList parseQuoted)-      m <-   parseRequired "mode:"             readConfig-      return (ModuleConfig p d is is2 es ep m)+      p   <- parseOptional "root:"           "" parseQuoted+      d   <- parseRequired "path:"              parseQuoted+      em  <- parseOptional "expression_map:" [] (parseList parseExprMacro)+      is  <- parseOptional "public_deps:"    [] (parseList parseQuoted)+      is2 <- parseOptional "private_deps:"   [] (parseList parseQuoted)+      es  <- parseOptional "extra_files:"    [] (parseList readConfig)+      ep  <- parseOptional "include_paths:"  [] (parseList parseQuoted)+      m   <- parseRequired "mode:"              readConfig+      return (ModuleConfig p d em is is2 es ep m)   writeConfig m = do     extra    <- fmap concat $ collectAllOrErrorM $ map writeConfig $ rmExtraFiles m     mode <- writeConfig (rmMode m)+    when (not $ null $ rmExprMap m) $ compileError "Only empty expression maps are allowed when writing"     return $ [         "root: " ++ show (rmRoot m),         "path: " ++ show (rmPath m),+        "expression_map: [",+        -- NOTE: expression_map isn't output because that would require making+        -- all Expression serializable.+        "]",         "public_deps: ["       ] ++ indents (map show $ rmPublicDeps m) ++ [         "]",@@ -362,3 +371,12 @@       ]   writeConfig CompileUnspecified = writeConfig (CompileIncremental [])   writeConfig _ = compileError "Invalid compile mode"++parseExprMacro :: Parser (String,Expression SourcePos)+parseExprMacro = do+  sepAfter (string_ "expression_macro")+  structOpen+  n <- parseRequired "name:"       parseMacroName+  e <- parseRequired "expression:" sourceParser+  structClose+  return (n,e)

@@ -17,7 +17,9 @@ -- Author: Kevin P. Barry [ta0kira@gmail.com]  module Cli.ProcessMetadata (+  MetadataMap,   checkAllowedStale,+  checkMetadataFreshness,   createCachePath,   eraseCachedData,   findSourceFiles,@@ -25,6 +27,7 @@   fixPaths,   getCachedPath,   getCacheRelativePath,+  getExprMap,   getIncludePathsForDeps,   getLinkFlagsForDeps,   getNamespacesForDeps,@@ -38,6 +41,7 @@   loadPublicDeps,   loadTestingDeps,   loadMetadata,+  mapMetadata,   resolveCategoryDeps,   resolveObjectDeps,   sortCompiledFiles,@@ -55,6 +59,7 @@ import System.Exit (exitFailure) import System.FilePath import System.IO+import Text.Parsec (SourcePos) import qualified Data.Map as Map import qualified Data.Set as Set @@ -63,8 +68,10 @@ import Cli.CompileOptions import Cli.ParseMetadata -- Not safe, due to Text.Regex.TDFA. import Compilation.CompileInfo+import Compilation.ProcedureContext (ExprMap) import CompilerCxx.Category (CxxOutput(..)) import Config.Programs (VersionHash(..))+import Types.Procedure (Expression(Literal),ValueLiteral(..)) import Types.TypeCategory import Types.TypeInstance @@ -85,30 +92,42 @@                        "Recompile them or use -f to force."     exitFailure -loadMetadata :: FilePath -> IO CompileMetadata-loadMetadata p = do-  let f = p </> cachedDataPath </> metadataFilename-  isFile <- doesFileExist p-  when isFile $ do-    hPutStrLn stderr $ "Path \"" ++ p ++ "\" is not a directory."-    exitFailure-  isDir <- doesDirectoryExist p-  when (not isDir) $ do-    hPutStrLn stderr $ "Path \"" ++ p ++ "\" does not exist."-    exitFailure-  filePresent <- doesFileExist f-  when (not filePresent) $ do-    hPutStrLn stderr $ "Module \"" ++ p ++ "\" has not been compiled yet."-    exitFailure-  c <- readFile f-  let m = autoReadConfig f c-  if isCompileError m-     then do-       hPutStrLn stderr $ "Could not parse metadata from \"" ++ p ++ "\"; please recompile."-       hPutStrLn stderr $ show (getCompileError m)-       exitFailure-     else return (getCompileSuccess m)+type MetadataMap = Map.Map FilePath CompileMetadata +mapMetadata :: [CompileMetadata] -> MetadataMap+mapMetadata cs = Map.fromList $ zip (map cmPath cs) cs++loadMetadata :: MetadataMap -> FilePath -> IO CompileMetadata+loadMetadata ca p = do+  path <- canonicalizePath p+  case path `Map.lookup` ca of+       Just cm -> return cm+       Nothing -> do+         let f = p </> cachedDataPath </> metadataFilename+         isFile <- doesFileExist p+         when isFile $ do+           hPutStrLn stderr $ "Path \"" ++ p ++ "\" is not a directory."+           exitFailure+         isDir <- doesDirectoryExist p+         when (not isDir) $ do+           hPutStrLn stderr $ "Path \"" ++ p ++ "\" does not exist."+           exitFailure+         filePresent <- doesFileExist f+         when (not filePresent) $ do+           hPutStrLn stderr $ "Module \"" ++ p ++ "\" has not been compiled yet."+           exitFailure+         c <- readFile f+         let m = autoReadConfig f c+         if isCompileError m+            then do+              hPutStrLn stderr $ "Could not parse metadata from \"" ++ p ++ "\"; please recompile."+              hPutStrLn stderr $ show (getCompileError m)+              exitFailure+            else return (getCompileSuccess m)++checkMetadataFreshness :: FilePath -> CompileMetadata -> IO Bool+checkMetadataFreshness = checkModuleFreshness False+ tryLoadMetadata :: FilePath -> IO (Maybe CompileMetadata) tryLoadMetadata p = tryLoadData $ (p </> cachedDataPath </> metadataFilename) @@ -136,7 +155,7 @@   case m of        Nothing -> return False        Just _ -> do-         (fr,_) <- loadDepsCommon True h Set.empty (\m2 -> cmPublicDeps m2 ++ cmPrivateDeps m2) [p]+         (fr,_) <- loadDepsCommon True h Map.empty Set.empty (\m2 -> cmPublicDeps m2 ++ cmPrivateDeps m2) [p]          return fr  isPathConfigured :: FilePath -> IO Bool@@ -214,6 +233,12 @@   let ts = filter (isSuffixOf ".0rt") ds   return (ps,xs,ts) +getExprMap :: FilePath -> ModuleConfig -> IO (ExprMap SourcePos)+getExprMap p m = do+  path <- canonicalizePath (p </> rmRoot m </> rmPath m)+  let defaults = [("MODULE_PATH",Literal (StringLiteral [] path))]+  return $ Map.fromList $ rmExprMap m ++ defaults+ getRealPathsForDeps :: [CompileMetadata] -> [FilePath] getRealPathsForDeps = map cmPath @@ -233,35 +258,40 @@ getObjectFilesForDeps :: [CompileMetadata] -> [ObjectFile] getObjectFilesForDeps = concat . map cmObjectFiles -loadPublicDeps :: VersionHash -> [FilePath] -> IO (Bool,[CompileMetadata])-loadPublicDeps h = loadDepsCommon False h Set.empty cmPublicDeps+loadPublicDeps :: VersionHash -> MetadataMap -> [FilePath] -> IO (Bool,[CompileMetadata])+loadPublicDeps h ca = loadDepsCommon False h ca Set.empty cmPublicDeps -loadTestingDeps :: VersionHash -> CompileMetadata -> IO (Bool,[CompileMetadata])-loadTestingDeps h m = loadDepsCommon False h (Set.fromList [cmPath m]) cmPublicDeps (cmPublicDeps m ++ cmPrivateDeps m)+loadTestingDeps :: VersionHash -> MetadataMap -> CompileMetadata -> IO (Bool,[CompileMetadata])+loadTestingDeps h ca m = loadDepsCommon False h ca (Set.fromList [cmPath m]) cmPublicDeps (cmPublicDeps m ++ cmPrivateDeps m) -loadPrivateDeps :: VersionHash -> [CompileMetadata] -> IO (Bool,[CompileMetadata])-loadPrivateDeps h ms = do-  (fr,new) <- loadDepsCommon False h pa (\m -> cmPublicDeps m ++ cmPrivateDeps m) paths+loadPrivateDeps :: VersionHash -> MetadataMap -> [CompileMetadata] -> IO (Bool,[CompileMetadata])+loadPrivateDeps h ca ms = do+  (fr,new) <- loadDepsCommon False h ca pa (\m -> cmPublicDeps m ++ cmPrivateDeps m) paths   return (fr,ms ++ new) where     paths = concat $ map (\m -> cmPublicDeps m ++ cmPrivateDeps m) ms     pa = Set.fromList $ map cmPath ms -loadDepsCommon :: Bool -> VersionHash -> Set.Set FilePath ->+loadDepsCommon :: Bool -> VersionHash -> MetadataMap -> Set.Set FilePath ->   (CompileMetadata -> [FilePath]) -> [FilePath] -> IO (Bool,[CompileMetadata])-loadDepsCommon s h pa0 f ps = fmap snd $ fixedPaths >>= collect (pa0,(True,[])) where+loadDepsCommon s h ca pa0 f ps = fmap snd $ fixedPaths >>= collect (pa0,(True,[])) where   fixedPaths = sequence $ map canonicalizePath ps   collect xa@(pa,(fr,xs)) (p:ps2)     | p `Set.member` pa = collect xa ps2     | otherwise = do-        when (not s) $ hPutStrLn stderr $ "Loading metadata for dependency \"" ++ p ++ "\"."-        m <- loadMetadata p-        fresh <- checkModuleFreshness s p m-        when (not s && not fresh) $-          hPutStrLn stderr $ "Module \"" ++ p ++ "\" is out of date and should be recompiled."-        let sameVersion = checkModuleVersionHash h m-        when (not s && not sameVersion) $-          hPutStrLn stderr $ "Module \"" ++ p ++ "\" was compiled with a different compiler setup."-        collect (p `Set.insert` pa,(sameVersion && fresh && fr,xs ++ [m])) (ps2 ++ f m)+        (m,fr2) <-+          case p `Map.lookup` ca of+               Just m2 -> return (m2,True)+               Nothing -> do+                 when (not s) $ hPutStrLn stderr $ "Loading metadata for dependency \"" ++ p ++ "\"."+                 m2 <- loadMetadata ca p+                 fresh <- checkModuleFreshness s p m2+                 when (not s && not fresh) $+                   hPutStrLn stderr $ "Module \"" ++ p ++ "\" is out of date and should be recompiled."+                 let sameVersion = checkModuleVersionHash h m2+                 when (not s && not sameVersion) $+                   hPutStrLn stderr $ "Module \"" ++ p ++ "\" was compiled with a different compiler setup."+                 return (m2,sameVersion && fresh)+        collect (p `Set.insert` pa,(fr2 && fr,xs ++ [m])) (ps2 ++ f m)   collect xa _ = return xa  fixPath :: FilePath -> FilePath

@@ -27,6 +27,7 @@ import System.FilePath import System.Posix.Temp (mkdtemp) import System.IO+import qualified Data.Map as Map import qualified Data.Set as Set  import Base.CompileError@@ -45,21 +46,34 @@ runCompiler (CompileOptions _ _ _ ds _ _ p (ExecuteTests tp) f) = do   (backend,resolver) <- loadConfig   base <- resolveBaseModule resolver-  ts <- sequence $ map (preloadTests backend base) ds+  ts <- fmap snd $ foldM (preloadTests backend base) (Map.empty,[]) ds   checkTestFilters ts   allResults <- fmap concat $ sequence $ map (runModuleTests backend base tp) ts   let passed = sum $ map (fst . fst) allResults   let failed = sum $ map (snd . fst) allResults   processResults passed failed (mergeAllM $ map snd allResults) where-    preloadTests b base d = do-      m <- loadMetadata (p </> d)-      (fr0,deps0) <- loadPublicDeps (getCompilerHash b) [base]+    preloadTests b base (ca,ms) d = do+      m <- loadMetadata ca (p </> d)+      let ca2 = ca `Map.union` mapMetadata [m]+      fr <- checkMetadataFreshness (p </> d) m+      checkAllowedStale fr f+      rm <- tryLoadRecompile (p </> d)+      rm' <- case rm of+                  Just rm2 -> return rm2+                  Nothing -> do+                    hPutStr stderr $ "Module config for " ++ d ++ " is missing."+                    exitFailure+      (fr0,deps0) <- loadPublicDeps (getCompilerHash b) ca2 [base]+      let ca3 = ca2 `Map.union` mapMetadata deps0       checkAllowedStale fr0 f-      (fr1,deps1) <- loadTestingDeps (getCompilerHash b) m+      (fr1,deps1) <- loadTestingDeps (getCompilerHash b) ca3 m+      let ca4 = ca3 `Map.union` mapMetadata deps1       checkAllowedStale fr1 f-      (fr2,deps2) <- loadPrivateDeps (getCompilerHash b) (deps0++[m]++deps1)+      (fr2,deps2) <- loadPrivateDeps (getCompilerHash b) ca4 (deps0++[m]++deps1)+      let ca5 = ca4 `Map.union` mapMetadata deps2       checkAllowedStale fr2 f-      return $ LoadedTests p d m (deps0++[m]++deps1) deps2+      em <- getExprMap (p </> d) rm'+      return (ca5,ms ++ [LoadedTests p d m em (deps0++[m]++deps1) deps2])     checkTestFilters ts = do       let possibleTests = Set.fromList $ concat $ map (cmTestFiles . ltMetadata) ts       case Set.toList $ (Set.fromList tp) `Set.difference` possibleTests of@@ -82,9 +96,21 @@   dir <- mkdtemp "/tmp/zfast_"   absolute <- canonicalizePath p   f2' <- canonicalizePath (p </> f2)+  let rm = ModuleConfig {+    rmRoot = "",+    rmPath = ".",+    rmExprMap = [],+    rmPublicDeps = [],+    rmPrivateDeps = [],+    rmExtraFiles = [],+    rmExtraPaths = [],+    rmMode = CompileUnspecified+  }+  em <- getExprMap p rm   let spec = ModuleSpec {     msRoot = absolute,     msPath = dir,+    msExprMap = em,     msPublicDeps = is,     msPrivateDeps = is2,     msPublicFiles = [],@@ -99,22 +125,29 @@   removeDirectoryRecursive dir  runCompiler (CompileOptions h _ _ ds _ _ p CompileRecompileRecursive f) = do-  foldM recursive Set.empty ds >> return () where-    recursive da d0 = do-      d <- canonicalizePath (p </> d0)-      rm <- tryLoadRecompile d-      case rm of-           Nothing -> do-             hPutStrLn stderr $ "Path " ++ d ++ " does not have a valid configuration."-             exitFailure-           Just m ->-             if rmPath m `Set.member` da-                then return da-                else do-                  let ds3 = map (\d2 -> d </> d2) (rmPublicDeps m ++ rmPrivateDeps m)-                  da' <- foldM recursive (rmPath m `Set.insert` da) ds3-                  runCompiler (CompileOptions h [] [] [d] [] [] p CompileRecompile f)-                  return da'+  (_,resolver) <- loadConfig+  foldM (recursive resolver) Set.empty ds >> return () where+    recursive r da d0 = do+      isSystem <- isSystemModule r p d0+      if isSystem+         then do+           hPutStrLn stderr $ "Skipping system module " ++ d0 ++ "."+           exitFailure+         else do+           d <- canonicalizePath (p </> d0)+           rm <- tryLoadRecompile d+           case rm of+                Nothing -> do+                  hPutStrLn stderr $ "Path " ++ d ++ " does not have a valid configuration."+                  exitFailure+                Just m ->+                  if rmPath m `Set.member` da+                     then return da+                     else do+                       let ds3 = map (\d2 -> d </> d2) (rmPublicDeps m ++ rmPrivateDeps m)+                       da' <- foldM (recursive r) (rmPath m `Set.insert` da) ds3+                       runCompiler (CompileOptions h [] [] [d] [] [] p CompileRecompile f)+                       return da'  runCompiler (CompileOptions _ _ _ ds _ _ p CompileRecompile f) = do   (backend,_) <- loadConfig@@ -130,15 +163,17 @@         maybeCompile (Just rm') upToDate           | f < ForceAll && upToDate = hPutStrLn stderr $ "Path " ++ d0 ++ " is up to date."           | otherwise = do-              let (ModuleConfig p2 d is is2 es ep m) = rm'+              let (ModuleConfig p2 d _ is is2 es ep m) = rm'               -- In case the module is manually configured with a p such as "..",               -- since the absolute path might not be known ahead of time.               absolute <- canonicalizePath (p </> d0)               let fixed = fixPath (absolute </> p2)               (ps,xs,ts) <- findSourceFiles fixed d+              em <- getExprMap (p </> d0) rm'               let spec = ModuleSpec {                 msRoot = fixed,                 msPath = d,+                msExprMap = em,                 msPublicDeps = is,                 msPrivateDeps = is2,                 msPublicFiles = ps,@@ -157,9 +192,9 @@     base <- resolveBaseModule resolver     as  <- fmap fixPaths $ sequence $ map (resolveModule resolver (p </> d)) is     as2 <- fmap fixPaths $ sequence $ map (resolveModule resolver (p </> d)) is2-    (fr1,deps1) <- loadPublicDeps (getCompilerHash backend) (base:as)+    (fr1,deps1) <- loadPublicDeps (getCompilerHash backend) Map.empty (base:as)     checkAllowedStale fr1 f-    (fr2,deps2) <- loadPublicDeps (getCompilerHash backend) as2+    (fr2,deps2) <- loadPublicDeps (getCompilerHash backend) (mapMetadata deps1) as2     checkAllowedStale fr2 f     path <- canonicalizePath p     createModuleTemplates path d deps1 deps2@@ -178,6 +213,7 @@     let rm = ModuleConfig {       rmRoot = absolute,       rmPath = d,+      rmExprMap = [],       rmPublicDeps = as,       rmPrivateDeps = as2,       rmExtraFiles = es,

@@ -112,7 +112,7 @@     result (es,_,ws) = CompileFail ws $ CompileMessage "" es   collectOneOrErrorM = result . splitErrorsAndData where     result (_,x:_,ws) = CompileSuccess ws x-    result ([],_,ws)  = CompileFail ws $ CompileMessage "No choices found" []+    result ([],_,ws)  = CompileFail ws $ CompileMessage "" []     result (es,_,ws)  = CompileFail ws $ CompileMessage "" es   reviseErrorM x@(CompileSuccess _ _) _ = x   reviseErrorM (CompileFail w (CompileMessage [] ms)) s = CompileFail w $ CompileMessage s ms@@ -122,7 +122,7 @@ instance MergeableM CompileInfo where   mergeAnyM = result . splitErrorsAndData where     result (_,xs@(_:_),ws) = CompileSuccess ws $ mergeAny xs-    result ([],_,ws)       = CompileFail ws $ CompileMessage "No choices found" []+    result ([],_,ws)       = CompileFail ws $ CompileMessage "" []     result (es,_,ws)       = CompileFail ws $ CompileMessage "" es   mergeAllM = result . splitErrorsAndData where     result ([],xs,ws) = CompileSuccess ws $ mergeAll xs

@@ -36,9 +36,11 @@   csCheckVariableInit,   csClearOutput,   csCurrentScope,+  csExprLookup,   csGetCategoryFunction,   csGetCleanup,   csGetLoop,+  csGetNoTrace,   csGetOutput,   csGetParamScope,   csGetTypeFunction,@@ -53,6 +55,7 @@   csResolver,   csSameType,   csSetNoReturn,+  csSetNoTrace,   csStartLoop,   csUpdateAssigned,   csWrite,@@ -108,6 +111,9 @@   ccGetLoop :: a -> m (LoopSetup s)   ccPushCleanup :: a -> CleanupSetup a s -> m a   ccGetCleanup :: a -> m (CleanupSetup a s)+  ccExprLookup :: a -> [c] -> String -> m (Expression c)+  ccSetNoTrace :: a -> Bool -> m a+  ccGetNoTrace :: a -> m Bool  type ExpressionType = Positional ValueType @@ -232,6 +238,15 @@  csGetCleanup :: CompilerContext c m s a => CompilerState a m (CleanupSetup a s) csGetCleanup = fmap ccGetCleanup get >>= lift++csExprLookup :: CompilerContext c m s a => [c] -> String -> CompilerState a m (Expression c)+csExprLookup c n = fmap (\x -> ccExprLookup x c n) get >>= lift++csSetNoTrace :: CompilerContext c m s a => Bool -> CompilerState a m ()+csSetNoTrace t = fmap (\x -> ccSetNoTrace x t) get >>= lift >>= put++csGetNoTrace :: CompilerContext c m s a => CompilerState a m Bool+csGetNoTrace = fmap ccGetNoTrace get >>= lift  data CompiledData s =   CompiledData {

@@ -21,6 +21,7 @@ {-# LANGUAGE Safe #-}  module Compilation.ProcedureContext (+  ExprMap,   ProcedureContext(..),   ReturnValidation(..),   updateArgVariables,@@ -62,9 +63,13 @@     pcOutput :: [String],     pcDisallowInit :: Bool,     pcLoopSetup :: LoopSetup [String],-    pcCleanupSetup :: CleanupSetup (ProcedureContext c) [String]+    pcCleanupSetup :: CleanupSetup (ProcedureContext c) [String],+    pcExprMap :: ExprMap c,+    pcNoTrace :: Bool   } +type ExprMap c = Map.Map String (Expression c)+ data ReturnValidation c =   ValidatePositions {     vpReturns :: Positional (PassedValue c)@@ -106,7 +111,9 @@       pcOutput = pcOutput ctx,       pcDisallowInit = pcDisallowInit ctx,       pcLoopSetup = pcLoopSetup ctx,-      pcCleanupSetup = pcCleanupSetup ctx+      pcCleanupSetup = pcCleanupSetup ctx,+      pcExprMap = pcExprMap ctx,+      pcNoTrace = pcNoTrace ctx     }   ccGetRequired = return . pcRequiredTypes   ccGetCategoryFunction ctx c Nothing n = ccGetCategoryFunction ctx c (Just $ pcType ctx) n@@ -134,8 +141,9 @@     getFunction (Just t2@(TypeMerge MergeUnion _)) =       compileError $ "Use explicit type conversion to call " ++ show n ++ " for union type " ++                      show t2 ++ formatFullContextBrace c-    getFunction (Just (TypeMerge MergeIntersect ts)) =-      collectOneOrErrorM $ map getFunction $ map Just ts+    getFunction (Just ta@(TypeMerge MergeIntersect ts)) =+      collectOneOrErrorM (map getFunction $ map Just ts) `reviseError`+        ("Function " ++ show n ++ " not available for type " ++ show ta ++ formatFullContextBrace c)     getFunction (Just (SingleType (JustParamName p))) = do       fa <- ccAllFilters ctx       fs <- case p `Map.lookup` fa of@@ -143,10 +151,8 @@                 _ -> compileError $ "Param " ++ show p ++ " does not exist"       let ts = map tfType $ filter isRequiresFilter fs       let ds = map dfType $ filter isDefinesFilter  fs-      collectOneOrErrorM $-        [compileError $ "Function " ++ show n ++ " not available for param " ++ show p ++-         formatFullContextBrace c] ++-        (map getFunction $ map (Just . SingleType) ts) ++ (map checkDefine ds)+      collectOneOrErrorM (map (getFunction . Just . SingleType) ts ++ map checkDefine ds) `reviseError`+        ("Function " ++ show n ++ " not available for param " ++ show p ++ formatFullContextBrace c)     getFunction (Just (SingleType (JustTypeInstance t2)))       -- Same category as the procedure itself.       | tiName t2 == pcType ctx =@@ -245,7 +251,9 @@         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,-        pcCleanupSetup = pcCleanupSetup ctx+        pcCleanupSetup = pcCleanupSetup ctx,+        pcExprMap = pcExprMap ctx,+        pcNoTrace = pcNoTrace ctx       }   ccCheckVariableInit ctx c n =     case pcReturns ctx of@@ -272,7 +280,9 @@       pcOutput = pcOutput ctx ++ ss,       pcDisallowInit = pcDisallowInit ctx,       pcLoopSetup = pcLoopSetup ctx,-      pcCleanupSetup = pcCleanupSetup ctx+      pcCleanupSetup = pcCleanupSetup ctx,+      pcExprMap = pcExprMap ctx,+      pcNoTrace = pcNoTrace ctx     }   ccGetOutput = return . pcOutput   ccClearOutput ctx = return $ ProcedureContext {@@ -294,7 +304,9 @@         pcOutput = [],         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,-        pcCleanupSetup = pcCleanupSetup ctx+        pcCleanupSetup = pcCleanupSetup ctx,+        pcExprMap = pcExprMap ctx,+        pcNoTrace = pcNoTrace ctx       }   ccUpdateAssigned ctx n = update (pcReturns ctx) where     update (ValidateNames ts ra) = return $ ProcedureContext {@@ -316,7 +328,9 @@         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,-        pcCleanupSetup = pcCleanupSetup ctx+        pcCleanupSetup = pcCleanupSetup ctx,+        pcExprMap = pcExprMap ctx,+        pcNoTrace = pcNoTrace ctx       }     update _ = return ctx   ccInheritReturns ctx cs = return $ ProcedureContext {@@ -338,7 +352,9 @@       pcOutput = pcOutput ctx,       pcDisallowInit = pcDisallowInit ctx,       pcLoopSetup = pcLoopSetup ctx,-      pcCleanupSetup = pcCleanupSetup ctx+      pcCleanupSetup = pcCleanupSetup ctx,+      pcExprMap = pcExprMap ctx,+      pcNoTrace = pcNoTrace ctx     }     where       inherited = foldr combineParallel UnreachableCode (map pcReturns cs)@@ -373,13 +389,18 @@         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,-        pcCleanupSetup = pcCleanupSetup ctx+        pcCleanupSetup = pcCleanupSetup ctx,+        pcExprMap = pcExprMap ctx,+        pcNoTrace = pcNoTrace ctx       }     where       check (ValidatePositions rs) = do         let vs' = case vs of                        Nothing -> Positional []                        Just vs2 -> vs2+        -- Check for a count match first, to avoid the default error message.+        processPairs_ alwaysPair (fmap pvType rs) vs' `reviseError`+          ("In procedure return at " ++ formatFullContext c)         processPairs_ checkReturnType rs (Positional $ zip ([0..] :: [Int]) $ pValues vs') `reviseError`           ("In procedure return at " ++ formatFullContext c)         return ()@@ -425,7 +446,9 @@         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,-        pcCleanupSetup = pcCleanupSetup ctx+        pcCleanupSetup = pcCleanupSetup ctx,+        pcExprMap = pcExprMap ctx,+        pcNoTrace = pcNoTrace ctx       }   ccStartLoop ctx l =     return $ ProcedureContext {@@ -447,7 +470,9 @@         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = l,-        pcCleanupSetup = pcCleanupSetup ctx+        pcCleanupSetup = pcCleanupSetup ctx,+        pcExprMap = pcExprMap ctx,+        pcNoTrace = pcNoTrace ctx       }   ccGetLoop = return . pcLoopSetup   ccPushCleanup ctx (CleanupSetup cs ss) =@@ -471,9 +496,40 @@         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,         pcCleanupSetup = CleanupSetup (cs ++ (csReturnContext $ pcCleanupSetup ctx))-                                      (ss ++ (csCleanup $ pcCleanupSetup ctx))+                                      (ss ++ (csCleanup $ pcCleanupSetup ctx)),+        pcExprMap = pcExprMap ctx,+        pcNoTrace = pcNoTrace ctx       }   ccGetCleanup = return . pcCleanupSetup+  ccExprLookup ctx c n =+    case n `Map.lookup` pcExprMap ctx of+         Nothing -> compileError $ "Env expression " ++ n ++ " is not defined" ++ formatFullContextBrace c+         Just e -> return e+  ccSetNoTrace ctx t =+    return $ ProcedureContext {+        pcScope = pcScope ctx,+        pcType = pcType ctx,+        pcExtParams = pcExtParams ctx,+        pcIntParams = pcIntParams ctx,+        pcMembers = pcMembers ctx,+        pcCategories = pcCategories ctx,+        pcAllFilters = pcAllFilters ctx,+        pcExtFilters = pcExtFilters ctx,+        pcIntFilters = pcIntFilters ctx,+        pcParamScopes = pcParamScopes ctx,+        pcFunctions = pcFunctions ctx,+        pcVariables = pcVariables ctx,+        pcReturns = pcReturns ctx,+        pcPrimNamed = pcPrimNamed ctx,+        pcRequiredTypes = pcRequiredTypes ctx,+        pcOutput = pcOutput ctx,+        pcDisallowInit = pcDisallowInit ctx,+        pcLoopSetup = pcLoopSetup ctx,+        pcCleanupSetup = pcCleanupSetup ctx,+        pcExprMap = pcExprMap ctx,+        pcNoTrace = t+      }+  ccGetNoTrace = return . pcNoTrace  updateReturnVariables :: (Show c, CompileErrorM m, MergeableM m) =>   (Map.Map VariableName (VariableValue c)) ->

@@ -32,6 +32,7 @@  import Base.CompileError import Base.Mergeable+import Compilation.ProcedureContext import Types.DefinedCategory import Types.GeneralType import Types.Positional@@ -50,7 +51,8 @@     scExternalFilters :: [ParamFilter c],     scInternalFilters :: [ParamFilter c],     scFunctions :: Map.Map FunctionName (ScopedFunction c),-    scVariables :: Map.Map VariableName (VariableValue c)+    scVariables :: Map.Map VariableName (VariableValue c),+    scExprMap :: ExprMap c   }  data ProcedureScope c =@@ -64,8 +66,8 @@ applyProcedureScope f (ProcedureScope ctx fs) = map (uncurry (f ctx)) fs  getProcedureScopes :: (Show c, CompileErrorM m, MergeableM m) =>-  CategoryMap c -> DefinedCategory c -> m [ProcedureScope c]-getProcedureScopes ta (DefinedCategory c n pi _ _ fi ms ps fs) = do+  CategoryMap c -> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]+getProcedureScopes ta em (DefinedCategory c n pi _ _ fi ms ps fs) = do   (_,t) <- getConcreteCategory ta (c,n)   let params = Positional $ getCategoryParams t   let params2 = Positional pi@@ -87,9 +89,9 @@   let cv = Map.union cm0 cm'   let tv = Map.union tm0 tm'   let vv = Map.union vm0 vm'-  let ctxC = ScopeContext ta n params params2 vm filters filters2 fa cv-  let ctxT = ScopeContext ta n params params2 vm filters filters2 fa tv-  let ctxV = ScopeContext ta n params params2 vm filters filters2 fa vv+  let ctxC = ScopeContext ta n params params2 vm filters filters2 fa cv em+  let ctxT = ScopeContext ta n params params2 vm filters filters2 fa tv em+  let ctxV = ScopeContext ta n params params2 vm filters filters2 fa vv em   return [ProcedureScope ctxC cp,ProcedureScope ctxT tp,ProcedureScope ctxV vp]   where     builtins t s0 = Map.filter ((<= s0) . vvScope) $ builtinVariables t

@@ -41,6 +41,7 @@ import Base.CompileError import Base.Mergeable import Compilation.CompilerState+import Compilation.ProcedureContext (ExprMap) import Compilation.ScopeContext import CompilerCxx.CategoryContext import CompilerCxx.Code@@ -50,6 +51,7 @@ import Types.DefinedCategory import Types.GeneralType import Types.Positional+import Types.Pragma import Types.Procedure import Types.TypeCategory import Types.TypeInstance@@ -78,7 +80,8 @@     lmPublicLocal :: [AnyCategory c],     lmPrivateLocal :: [AnyCategory c],     lmTestingLocal :: [AnyCategory c],-    lmExternal :: [CategoryName]+    lmExternal :: [CategoryName],+    lmExprMap :: ExprMap c   }  data PrivateSource c =@@ -91,8 +94,11 @@  compileLanguageModule :: (Show c, CompileErrorM m, MergeableM m) =>   LanguageModule c -> [PrivateSource c] -> m ([CxxOutput],[CxxOutput])-compileLanguageModule (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 ex) xa = do+compileLanguageModule (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 ex em) xa = do   checkSupefluous $ Set.toList $ (Set.fromList ex) `Set.difference` ca+  -- Check public sources up front so that error messages aren't duplicated for+  -- every source file.+  _ <- tmTesting   (hxx1,cxx1) <- fmap mergeGeneratedP $ collectAllOrErrorM $ map (compileSourceP tmPublic  nsPublic)  cs1   (hxx2,cxx2) <- fmap mergeGeneratedP $ collectAllOrErrorM $ map (compileSourceP tmPrivate nsPrivate) ps1   (hxx3,cxx3) <- fmap mergeGeneratedP $ collectAllOrErrorM $ map (compileSourceP tmTesting nsTesting) ts1@@ -145,7 +151,7 @@     compileDefinition tm ns4 d = do       tm' <- mergeInternalInheritance tm d       let refines = dcName d `Map.lookup` tm >>= return . getCategoryRefines-      compileConcreteDefinition tm' ns4 refines d+      compileConcreteDefinition tm' em ns4 refines d     mapByName = Map.fromListWith (++) . map (\d -> (dcName d,[d]))     ca = Set.fromList $ map getCategoryName $ filter isValueConcrete (cs1 ++ ps1 ++ ts1)     checkLocals ds cs2 = mergeAllM $ map (checkLocal $ Set.fromList cs2) ds@@ -180,25 +186,25 @@  compileTestMain :: (Show c, CompileErrorM m, MergeableM m) =>   LanguageModule c -> PrivateSource c -> Expression c -> m CxxOutput-compileTestMain (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 _) ts2 e = do+compileTestMain (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 _ em) ts2 e = do   tm' <- tm-  (req,main) <- createTestFile tm' e+  (req,main) <- createTestFile tm' em e   return $ CxxOutput Nothing testFilename NoNamespace ([psNamespace ts2]++ns0++ns1++ns2) req main where   tm = foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1,ts0,ts1,psCategory ts2]  compileModuleMain :: (Show c, CompileErrorM m, MergeableM m) =>   LanguageModule c -> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput-compileModuleMain (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 _) xa n f = do-  let resolved = filter (\d -> dcName d == n) $ concat $ map psDefine xa+compileModuleMain (LanguageModule ns0 ns1 ns2 cs0 ps0 _ cs1 ps1 _ _ em) xa n f = do+  let resolved = filter (\d -> dcName d == n) $ concat $ map psDefine $ filter (not . psTesting) xa   reconcile resolved   tm' <- tm   let cs = filter (\c -> getCategoryName c == n) $ concat $ map psCategory xa   tm'' <- includeNewTypes tm' cs-  (ns,main) <- createMainFile tm'' n f+  (ns,main) <- createMainFile tm'' em n f   return $ CxxOutput Nothing mainFilename NoNamespace ([ns]++ns0++ns1++ns2) [n] main where-    tm = foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1,ts0,ts1]+    tm = foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1]     reconcile [_] = return ()-    reconcile []  = compileErrorM $ "No matches for main category " ++ show n+    reconcile []  = compileErrorM $ "No matches for main category " ++ show n ++ " ($TestsOnly$ sources excluded)"     reconcile ds  =       flip reviseError ("Multiple matches for main category " ++ show n) $         mergeAllM $ map (\d -> compileError $ "Defined at " ++ formatFullContext (dcContext d)) ds@@ -259,7 +265,7 @@   CategoryMap c -> CategoryName -> m CxxOutput compileConcreteTemplate ta n = do   (_,t) <- getConcreteCategory ta ([],n)-  compileConcreteDefinition ta [] Nothing (defined t) `reviseError` ("In generated template for " ++ show n) where+  compileConcreteDefinition ta Map.empty [] Nothing (defined t) `reviseError` ("In generated template for " ++ show n) where     defined t = DefinedCategory {         dcContext = [],         dcName = getCategoryName t,@@ -273,6 +279,7 @@       }     defaultFail f = ExecutableProcedure {         epContext = [],+        epPragmas = [],         epEnd = [],         epName = sfName f,         epArgs = ArgValues [] $ Positional $ map createArg [1..(length $ pValues $ sfArgs f)],@@ -287,11 +294,12 @@     funcName f = show (sfType f) ++ "." ++ show (sfName f)  compileConcreteDefinition :: (Show c, CompileErrorM m, MergeableM m) =>-  CategoryMap c -> [Namespace] -> Maybe [ValueRefine c] -> DefinedCategory c -> m CxxOutput-compileConcreteDefinition ta ns rs dd@(DefinedCategory c n pi _ _ fi ms _ fs) = do+  CategoryMap c -> ExprMap c -> [Namespace] -> Maybe [ValueRefine c] ->+  DefinedCategory c -> m CxxOutput+compileConcreteDefinition ta em ns rs dd@(DefinedCategory c n pi _ _ fi ms _ fs) = do   (_,t) <- getConcreteCategory ta (c,n)   let r = CategoryResolver ta-  [cp,tp,vp] <- getProcedureScopes ta dd+  [cp,tp,vp] <- getProcedureScopes ta em dd   cf <- collectAllOrErrorM $ applyProcedureScope compileExecutableProcedure cp   tf <- collectAllOrErrorM $ applyProcedureScope compileExecutableProcedure tp   vf <- collectAllOrErrorM $ applyProcedureScope compileExecutableProcedure vp@@ -323,6 +331,7 @@       fmap indentCompiled $ mergeAllM $ map (createMember r allFilters) vm,       fmap indentCompiled $ createParams,       return $ indentCompiled $ onlyCode $ typeName n ++ "& parent;",+      return $ indentCompiled $ onlyCodes $ traceCreation (psProcedures vp),       return $ onlyCode "};"     ]   bottom <- mergeAllM $ [@@ -359,7 +368,7 @@         "CycleCheck<" ++ n2 ++ "> marker(*this);"       ]     categoryConstructor t ms2 = do-      ctx <- getContextForInit ta t dd CategoryScope+      ctx <- getContextForInit ta em t dd CategoryScope       initMembers <- runDataCompiler (sequence $ map compileLazyInit ms2) ctx       let initMembersStr = intercalate ", " $ cdOutput initMembers       let initColon = if null initMembersStr then "" else " : "@@ -378,7 +387,7 @@       let initParent = "parent(p)"       let initPassed = map (\(i,p) -> paramName p ++ "(*std::get<" ++ show i ++ ">(params))") $ zip ([0..] :: [Int]) ps2       let allInit = intercalate ", " $ initParent:initPassed-      ctx <- getContextForInit ta t dd TypeScope+      ctx <- getContextForInit ta em t dd TypeScope       initMembers <- runDataCompiler (sequence $ map initMember ms2) ctx       mergeAllM [           return $ onlyCode $ typeName n ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {",@@ -433,6 +442,9 @@           "const ParamTuple& params," ++           "const ValueTuple& args) final {"         ] ++ createFunctionDispatch n ValueScope fs2 ++ ["}"]+    traceCreation vp+      | any isTraceCreation $ concat $ map (epPragmas . snd) vp = [captureCreationTrace]+      | otherwise = []  commonDefineAll :: MergeableM m =>   AnyCategory c -> [Namespace] -> Maybe [ValueRefine c] -> CompiledData [String] ->@@ -758,9 +770,9 @@                            Set.toList req2  createMainFile :: (Show c, CompileErrorM m, MergeableM m) =>-  CategoryMap c -> CategoryName -> FunctionName -> m (Namespace,[String])-createMainFile tm n f = flip reviseError ("In the creation of the main binary procedure") $ do-  ca <- fmap indentCompiled (compileMainProcedure tm expr)+  CategoryMap c -> ExprMap c -> CategoryName -> FunctionName -> m (Namespace,[String])+createMainFile tm em n f = flip reviseError ("In the creation of the main binary procedure") $ do+  ca <- fmap indentCompiled (compileMainProcedure tm em expr)   let file = createMainCommon "main" ca   (_,t) <- getConcreteCategory tm ([],n)   return (getCategoryNamespace t,file) where@@ -769,10 +781,10 @@     expr = Expression [] (TypeCall [] mainType funcCall) []  createTestFile :: (Show c, CompileErrorM m, MergeableM m) =>-  CategoryMap c -> Expression c -> m ([CategoryName],[String])-createTestFile tm e = flip reviseError ("In the creation of the test binary procedure") $ do-  ca@(CompiledData req _) <- fmap indentCompiled (compileMainProcedure tm e)-  let file = createMainCommon "main" ca+  CategoryMap c -> ExprMap c  -> Expression c -> m ([CategoryName],[String])+createTestFile tm em e = flip reviseError ("In the creation of the test binary procedure") $ do+  ca@(CompiledData req _) <- fmap indentCompiled (compileMainProcedure tm em e)+  let file = createMainCommon "test" ca   return (Set.toList req,file)  getCategoryMentions :: AnyCategory c -> [CategoryName]

@@ -19,7 +19,6 @@ {-# LANGUAGE Safe #-}  module CompilerCxx.CategoryContext (-  ScopeContext(..),   getContextForInit,   getMainContext,   getProcedureContext,@@ -44,8 +43,9 @@   getContextForInit :: (Show c, CompileErrorM m, MergeableM m) =>-  CategoryMap c -> AnyCategory c -> DefinedCategory c -> SymbolScope -> m (ProcedureContext c)-getContextForInit tm t d s = do+  CategoryMap c -> ExprMap c -> AnyCategory c -> DefinedCategory c ->+  SymbolScope -> m (ProcedureContext c)+getContextForInit tm em t d s = do   let ps = Positional $ getCategoryParams t   -- NOTE: This is always ValueScope for initializer checks.   let ms = filter ((== ValueScope) . dmScope) $ dcMembers d@@ -57,9 +57,7 @@   fa <- setInternalFunctions r t (dcFunctions d)   let typeInstance = TypeInstance (getCategoryName t) $ fmap (SingleType . JustParamName . vpParam) ps   let builtin = Map.filter ((== LocalScope) . vvScope) $ builtinVariables typeInstance-  -- Using < ensures that variables can only be referenced after initialization.-  -- TODO: This doesn't really help if access is done via a function.-  members <- mapMembers $ filter ((< s) . dmScope) (dcMembers d)+  members <- mapMembers $ filter ((<= s) . dmScope) (dcMembers d)   return $ ProcedureContext {       pcScope = s,       pcType = getCategoryName t,@@ -79,14 +77,16 @@       pcOutput = [],       pcDisallowInit = True,       pcLoopSetup = NotInLoop,-      pcCleanupSetup = CleanupSetup [] []+      pcCleanupSetup = CleanupSetup [] [],+      pcExprMap = em,+      pcNoTrace = False     }  getProcedureContext :: (Show c, CompileErrorM m, MergeableM m) =>   ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> m (ProcedureContext c)-getProcedureContext (ScopeContext tm t ps pi ms pa fi fa va)+getProcedureContext (ScopeContext tm t ps pi ms pa fi fa va em)                     ff@(ScopedFunction _ _ _ s as1 rs1 ps1 fs _)-                    (ExecutableProcedure _ _ _ as2 rs2 _) = do+                    (ExecutableProcedure _ _ _ _ as2 rs2 _) = do   rs' <- if isUnnamedReturns rs2             then return $ ValidatePositions rs1             else fmap (ValidateNames rs1 . Map.fromList) $ processPairs pairOutput rs1 (nrNames rs2)@@ -135,13 +135,15 @@       pcOutput = [],       pcDisallowInit = False,       pcLoopSetup = NotInLoop,-      pcCleanupSetup = CleanupSetup [] []+      pcCleanupSetup = CleanupSetup [] [],+      pcExprMap = em,+      pcNoTrace = False     }   where     pairOutput (PassedValue c1 t2) (OutputValue c2 n2) = return $ (n2,PassedValue (c2++c1) t2) -getMainContext :: CompileErrorM m => CategoryMap c -> m (ProcedureContext c)-getMainContext tm = return $ ProcedureContext {+getMainContext :: CompileErrorM m => CategoryMap c -> ExprMap c -> m (ProcedureContext c)+getMainContext tm em = return $ ProcedureContext {     pcScope = LocalScope,     pcType = CategoryNone,     pcExtParams = Positional [],@@ -160,5 +162,7 @@     pcOutput = [],     pcDisallowInit = False,     pcLoopSetup = NotInLoop,-    pcCleanupSetup = CleanupSetup [] []+    pcCleanupSetup = CleanupSetup [] [],+    pcExprMap = em,+    pcNoTrace = False   }

@@ -22,6 +22,7 @@   ExprValue(..),   PrimitiveType(..),   categoryBase,+  captureCreationTrace,   clearCompiled,   emptyCode,   escapeChar,@@ -36,6 +37,7 @@   predTraceContext,   readStoredVariable,   setTraceContext,+  showCreationTrace,   startCleanupTracing,   startFunctionTracing,   typeBase,@@ -95,6 +97,12 @@ predTraceContext c   | null c = ""   | otherwise = "PRED_CONTEXT_POINT(" ++ escapeChars (formatFullContext c) ++ ")"++captureCreationTrace :: String+captureCreationTrace = "CAPTURE_CREATION"++showCreationTrace :: String+showCreationTrace = "TRACE_CREATION"  data PrimitiveType =   PrimBool |

@@ -42,6 +42,8 @@ import Base.CompileError import Base.Mergeable import Compilation.CompilerState+import Compilation.ProcedureContext (ExprMap)+import Compilation.ScopeContext import CompilerCxx.CategoryContext import CompilerCxx.Code import CompilerCxx.Naming@@ -50,6 +52,7 @@ import Types.Function import Types.GeneralType import Types.Positional+import Types.Pragma import Types.Procedure import Types.TypeCategory import Types.TypeInstance@@ -59,23 +62,26 @@   ScopeContext c -> ScopedFunction c -> ExecutableProcedure c ->   m (CompiledData [String],CompiledData [String]) compileExecutableProcedure ctx ff@(ScopedFunction _ _ _ s as1 rs1 ps1 _ _)-                               pp@(ExecutableProcedure _ c n as2 rs2 p) = do+                               pp@(ExecutableProcedure c0 pragmas c n as2 rs2 p) = do   ctx' <- getProcedureContext ctx ff pp   output <- runDataCompiler compileWithReturn ctx'-  return (onlyCode header,wrapProcedure output)+  procedureTrace <- setProcedureTrace+  creationTrace  <- setCreationTrace+  return (onlyCode header,wrapProcedure output procedureTrace creationTrace)   where     t = scName ctx     compileWithReturn = do-      ctx0 <- getCleanContext+      ctx0 <- getCleanContext >>= lift . flip ccSetNoTrace (any isNoTrace pragmas)       compileProcedure ctx0 p >>= put       unreachable <- csIsUnreachable       when (not unreachable) $         doImplicitReturn [] `reviseErrorStateT`           ("In implicit return from " ++ show n ++ formatFullContextBrace c)-    wrapProcedure output =+    wrapProcedure output pt ct =       mergeAll $ [           onlyCode header2,-          indentCompiled $ onlyCode setProcedureTrace,+          indentCompiled $ onlyCodes pt,+          indentCompiled $ onlyCodes ct,           indentCompiled $ onlyCodes defineReturns,           indentCompiled $ onlyCodes nameParams,           indentCompiled $ onlyCodes nameArgs,@@ -101,7 +107,15 @@         "(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {"       | otherwise = undefined     returnType = "ReturnTuple"-    setProcedureTrace = startFunctionTracing $ show t ++ "." ++ show n+    setProcedureTrace+      | any isNoTrace pragmas = return []+      | otherwise             = return [startFunctionTracing $ show t ++ "." ++ show n]+    setCreationTrace+      | not $ any isTraceCreation pragmas = return []+      | s /= ValueScope =+          (compileWarningM $ "Creation tracing ignored for " ++ show s +++             " functions" ++ formatFullContextBrace c0) >> return []+      | otherwise = return [showCreationTrace]     defineReturns       | isUnnamedReturns rs2 = []       | otherwise            = [returnType ++ " returns(" ++ show (length $ pValues rs1) ++ ");"]@@ -125,7 +139,10 @@ compileCondition ctx c e = do   (e',ctx') <- lift $ runStateT compile ctx   lift (ccGetRequired ctx') >>= csRequiresTypes-  return $ predTraceContext c ++ e'+  noTrace <- csGetNoTrace+  if noTrace+     then return e'+     else return $ predTraceContext c ++ e'   where     compile = flip reviseErrorStateT ("In condition at " ++ formatFullContext c) $ do       (ts,e') <- compileExpression e@@ -151,11 +168,18 @@                                     formatFullContext (getStatementContext s) ++                                     " is unreachable" +maybeSetTrace :: (Show c, CompileErrorM m, MergeableM m,+                  CompilerContext c m [String] a) =>+  [c] -> CompilerState a m ()+maybeSetTrace c = do+  noTrace <- csGetNoTrace+  when (not noTrace) $ csWrite $ setTraceContext c+ compileStatement :: (Show c, CompileErrorM m, MergeableM m,                      CompilerContext c m [String] a) =>   Statement c -> CompilerState a m () compileStatement (EmptyReturn c) = do-  csWrite $ setTraceContext c+  maybeSetTrace c   doImplicitReturn c compileStatement (ExplicitReturn c es) = do   es' <- sequence $ map compileExpression $ pValues es@@ -164,7 +188,7 @@     -- Single expression, but possibly multi-return.     getReturn [(_,(Positional ts,e))] = do       csRegisterReturn c $ Just (Positional ts)-      csWrite $ setTraceContext c+      maybeSetTrace c       autoPositionalCleanup e     -- Multi-expression => must all be singles.     getReturn rs = do@@ -172,7 +196,7 @@         ("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) ++ ")"-      csWrite $ setTraceContext c+      maybeSetTrace c       autoPositionalCleanup e     checkArity (_,Positional [_]) = return ()     checkArity (i,Positional ts)  =@@ -202,19 +226,22 @@   lift $ (checkValueTypeMatch r fa t0 formattedRequiredValue) `reviseError`     ("In fail call at " ++ formatFullContext c)   csSetNoReturn-  csWrite $ setTraceContext c+  maybeSetTrace c   csWrite ["BUILTIN_FAIL(" ++ useAsUnwrapped e0 ++ ")"] compileStatement (IgnoreValues c e) = do   (_,e') <- compileExpression e-  csWrite $ setTraceContext c+  maybeSetTrace c   csWrite ["(void) (" ++ useAsWhatever e' ++ ");"] compileStatement (Assignment c as e) = do   (ts,e') <- compileExpression e   r <- csResolver   fa <- csAllFilters+  -- Check for a count match first, to avoid the default error message.+  _ <- processPairsT alwaysPair (fmap assignableName as) ts `reviseErrorStateT`+    ("In assignment at " ++ formatFullContext c)   _ <- processPairsT (createVariable r fa) as ts `reviseErrorStateT`     ("In assignment at " ++ formatFullContext c)-  csWrite $ setTraceContext c+  maybeSetTrace c   variableTypes <- sequence $ map (uncurry getVariableType) $ zip (pValues as) (pValues ts)   assignAll (zip3 ([0..] :: [Int]) variableTypes (pValues as)) e'   where@@ -275,7 +302,7 @@   let Positional [t2] = ts   lift $ (checkValueTypeMatch r fa t2 t1) `reviseError`     ("In initialization of " ++ show n ++ " at " ++ formatFullContext c)-  csWrite [variableName n ++ "([]() { return " ++ writeStoredVariable t1 e' ++ "; })"]+  csWrite [variableName n ++ "([this]() { return " ++ writeStoredVariable t1 e' ++ "; })"]  compileVoidExpression :: (Show c, CompileErrorM m, MergeableM m,                          CompilerContext c m [String] a) =>@@ -367,9 +394,12 @@            ctx0' <- lift $ ccClearOutput ctxP            ctxCl <- compileProcedure ctx0' p2            p2' <- lift $ ccGetOutput ctxCl+           noTrace <- csGetNoTrace            -- TODO: It might be helpful to add a new trace-context line for this            -- so that the line that triggered the cleanup is still in the trace.-           let p2'' = ["{",startCleanupTracing] ++ p2' ++ ["}"]+           let p2'' = if noTrace+                      then []+                      else ["{",startCleanupTracing] ++ p2' ++ ["}"]            ctxP' <- lift $ ccPushCleanup ctxP (CleanupSetup [ctxCl] p2'')            return (ctxP',p2'',ctxCl)          Nothing -> return (ctxP,[],ctxP)@@ -595,7 +625,7 @@     fa <- csAllFilters     let vt = ValueType RequiredValue $ SingleType $ JustTypeInstance t     lift $ (checkValueTypeMatch r fa t' vt) `reviseError`-      ("In conversion at " ++ formatFullContext c)+      ("In converted call at " ++ formatFullContext c)     f' <- lookupValueFunction vt f     compileFunctionCall (Just $ useAsUnwrapped e') f' f   transform e (ValueCall c f) = do@@ -629,6 +659,9 @@   scoped <- autoScope s   let lazy = s == CategoryScope   return (Positional [t],readStoredVariable lazy t (scoped ++ variableName n))+compileExpressionStart (NamedMacro c n) = do+  e <- csExprLookup c n+  compileExpression e `reviseErrorStateT` ("In env lookup at " ++ formatFullContext c) compileExpressionStart (CategoryCall c t f@(FunctionCall _ n _ _)) = do   f' <- csGetCategoryFunction c (Just t) n   csRequiresTypes $ Set.fromList [t,sfType f']@@ -799,12 +832,12 @@     checkArity (i,Positional ts)  =       compileError $ "Return position " ++ show i ++ " has " ++ show (length ts) ++ " values but should have 1"     checkArg r fa t0 (i,t1) = do-      checkValueTypeMatch r fa t1 t0 `reviseError` ("In argument " ++ show i)+      checkValueTypeMatch r fa t1 t0 `reviseError` ("In argument " ++ show i ++ " to " ++ show (sfName f))  compileMainProcedure :: (Show c, CompileErrorM m, MergeableM m) =>-  CategoryMap c -> Expression c -> m (CompiledData [String])-compileMainProcedure tm e = do-  ctx <- getMainContext tm+  CategoryMap c -> ExprMap c -> Expression c -> m (CompiledData [String])+compileMainProcedure tm em e = do+  ctx <- getMainContext tm em   runDataCompiler compiler ctx where     procedure = Procedure [] [IgnoreValues [] e]     compiler = do

@@ -34,6 +34,7 @@ import Control.Monad (when) import Data.Hashable (hash) import Data.List (intercalate,isPrefixOf,isSuffixOf)+import Data.Maybe (isJust) import Data.Version (showVersion,versionBranch) import GHC.IO.Handle import Numeric (showHex)@@ -166,17 +167,16 @@        _ -> exitFailure  instance PathResolver Resolver where-  resolveModule (SimpleResolver ls ps) p m = do-    let allowGlobal = not (".." `elem` components)-    m0 <- if allowGlobal && any (\l -> isPrefixOf (l ++ "/") m) ls-             then getDataFileName m >>= return . (:[])-             else return []-    let m2 = if allowGlobal-                then map (</> m) ps-                else []-    firstExisting m $ [p</>m] ++ m0 ++ m2 where-      components = map stripSlash $ splitPath m-      stripSlash = reverse . dropWhile (== '/') . reverse+  resolveModule r p m = do+    ps2 <- potentialSystemPaths r m+    firstExisting m $ [p</>m] ++ ps2+  isSystemModule r p m = do+    isDir <- doesDirectoryExist (p</>m)+    if isDir+       then return False+       else do+         ps2 <- potentialSystemPaths r m+         findModule ps2 >>= return . not . isJust   resolveBaseModule _ = do     let m = "base"     m0 <- getDataFileName m@@ -185,13 +185,32 @@     b <- resolveBaseModule r     return (f == b) +potentialSystemPaths :: Resolver -> FilePath -> IO [FilePath]+potentialSystemPaths (SimpleResolver ls ps) m = do+  let allowGlobal = not (".." `elem` components)+  m0 <- if allowGlobal && any (\l -> isPrefixOf (l ++ "/") m) ls+           then getDataFileName m >>= return . (:[])+           else return []+  let m2 = if allowGlobal+              then map (</> m) ps+              else []+  return $ m0 ++ m2 where+    components = map stripSlash $ splitPath m+    stripSlash = reverse . dropWhile (== '/') . reverse+ firstExisting :: FilePath -> [FilePath] -> IO FilePath-firstExisting n [] = do-  -- TODO: Allow error recovery here.-  hPutStrLn stderr $ "Could not find path " ++ n-  exitFailure-firstExisting n (p:ps) = do+firstExisting m ps = do+  p <- findModule ps+  case p of+       Nothing -> do+         hPutStrLn stderr $ "Could not find path " ++ m+         exitFailure+       Just p2 -> return p2++findModule :: [FilePath] -> IO (Maybe FilePath)+findModule [] = return Nothing+findModule (p:ps) = do   isDir <- doesDirectoryExist p   if isDir-     then canonicalizePath p-     else firstExisting n ps+     then fmap Just $ canonicalizePath p+     else findModule ps

@@ -25,5 +25,6 @@  class PathResolver r where   resolveModule :: r -> FilePath -> FilePath -> IO FilePath+  isSystemModule :: r -> FilePath -> FilePath -> IO Bool   resolveBaseModule :: r -> IO FilePath   isBaseModule :: r -> FilePath -> IO Bool

@@ -19,10 +19,14 @@ {-# LANGUAGE Safe #-}  module Parser.Pragma (+  parseMacroName,   parsePragmas,   pragmaComment,+  pragmaExprLookup,+  pragmaNoTrace,   pragmaModuleOnly,-  pragmaTestsOnly+  pragmaTestsOnly,+  pragmaTraceCreation, ) where  import Control.Monad (when)@@ -40,6 +44,27 @@ pragmaModuleOnly = autoPragma "ModuleOnly" $ Left parseAt where   parseAt c = PragmaVisibility [c] ModuleOnly +parseMacroName :: Parser String+parseMacroName = labeled "macro name" $ do+  h <- upper <|> char '_'+  t <- many (upper <|> digit <|> char '_')+  optionalSpace+  return (h:t)++pragmaExprLookup :: Parser (Pragma SourcePos)+pragmaExprLookup = autoPragma "ExprLookup" $ Right parseAt where+  parseAt c = do+    name <- parseMacroName+    return $ PragmaExprLookup [c] name++pragmaNoTrace :: Parser (Pragma SourcePos)+pragmaNoTrace = autoPragma "NoTrace" $ Left parseAt where+  parseAt c = PragmaTracing [c] NoTrace++pragmaTraceCreation :: Parser (Pragma SourcePos)+pragmaTraceCreation = autoPragma "TraceCreation" $ Left parseAt where+  parseAt c = PragmaTracing [c] TraceCreation+ pragmaTestsOnly :: Parser (Pragma SourcePos) pragmaTestsOnly = autoPragma "TestsOnly" $ Left parseAt where   parseAt c = PragmaVisibility [c] TestsOnly@@ -61,13 +86,14 @@ autoPragma :: String -> Either (SourcePos -> a) (SourcePos -> Parser a) -> Parser a autoPragma p f = do   c <- getPosition-  try $ pragmaStart >> string_ p+  try $ pragmaStart >> string_ p >> notFollowedBy alphaNum   hasArgs <- (pragmaArgsStart >> optionalSpace >> return True) <|> return False   x <- delegate hasArgs f c   if hasArgs      then do        extra <- manyTill anyChar (string_ "]$")        when (not $ null extra) $ fail $ "Content unused by pragma " ++ p ++ ": " ++ extra+       optionalSpace      else sepAfter pragmaEnd   return x where     delegate False (Left f2)  c = return $ f2 c

@@ -28,8 +28,10 @@ import qualified Data.Set as Set  import Parser.Common+import Parser.Pragma import Parser.TypeCategory () import Parser.TypeInstance ()+import Types.Pragma import Types.Positional import Types.Procedure import Types.TypeCategory@@ -43,10 +45,11 @@     as <- sourceParser     rs <- sourceParser     sepAfter (string_ "{")+    pragmas <- parsePragmas [pragmaNoTrace,pragmaTraceCreation]     pp <- sourceParser     c2 <- getPosition     sepAfter (string_ "}")-    return $ ExecutableProcedure [c] [c2] n as rs pp+    return $ ExecutableProcedure [c] pragmas [c2] n as rs pp  instance ParseFromSource (ArgValues SourcePos) where   sourceParser = labeled "procedure arguments" $ do@@ -413,6 +416,7 @@                  variableOrUnqualified <|>                  builtinCall <|>                  builtinValue <|>+                 exprLookup <|>                  try typeOrCategoryCall <|>                  typeCall where     parens = do@@ -440,6 +444,11 @@       c <- getPosition       n <- builtinValues       return $ NamedVariable (OutputValue [c] (VariableName n))+    exprLookup = do+      pragma <- pragmaExprLookup+      case pragma of+           (PragmaExprLookup c name) -> return $ NamedMacro c name+           _ -> undefined  -- Should be caught above.     variableOrUnqualified = do       c <- getPosition       n <- sourceParser :: Parser VariableName@@ -488,7 +497,7 @@     charLiteral = do       c <- getPosition       string_ "'"-      ch <- stringChar+      ch <- stringChar <|> char '"'       string_ "'"       optionalSpace       return $ CharLiteral [c] ch

@@ -27,6 +27,10 @@ import Cli.CompileOptions import Cli.ParseMetadata import Config.Programs (VersionHash(..))+import System.FilePath+import Test.Common+import Types.Positional+import Types.Procedure import Types.TypeCategory (FunctionName(..),Namespace(..)) import Types.TypeInstance (CategoryName(..)) @@ -192,6 +196,7 @@     checkWriteThenRead $ ModuleConfig {       rmRoot = "/home/projects",       rmPath = "special",+      rmExprMap = [],       rmPublicDeps = [         "/home/project/public-dep1",         "/home/project/public-dep2"@@ -228,6 +233,19 @@       }     }, +    checkWriteFail "empty.+map" $ ModuleConfig {+      rmRoot = "/home/projects",+      rmPath = "special",+      rmExprMap = [("MACRO",Literal (StringLiteral [] "something"))],+      rmPublicDeps = [],+      rmPrivateDeps = [],+      rmExtraFiles = [],+      rmExtraPaths = [],+      rmMode = CompileIncremental {+        ciLinkFlags = []+      }+    },+     checkWriteFail "bad category" $ CategorySource {       csSource = "extra1.cpp",       csCategories = [@@ -297,7 +315,21 @@     checkWriteFail "compile mode" $ ExecuteTests { etInclude = [] },     checkWriteFail "compile mode" $ CompileRecompile,     checkWriteFail "compile mode" $ CompileRecompileRecursive,-    checkWriteFail "compile mode" $ CreateTemplates+    checkWriteFail "compile mode" $ CreateTemplates,++    checkParsesAs ("testfiles" </> "module-config.txt")+      (\m -> case rmExprMap m of+                  [("MY_MACRO",+                    Expression _ (BuiltinCall _+                      (FunctionCall _ BuiltinRequire (Positional [])+                        (Positional [Literal (EmptyLiteral _)]))) []),+                   ("MY_OTHER_MACRO",+                    Expression _+                      (TypeCall _ _+                        (FunctionCall _ (FunctionName "execute") (Positional [])+                          (Positional [Literal (StringLiteral _ "this is a string\n")]))) [])+                    ] -> True+                  _ -> False)   ]  checkWriteThenRead :: (Eq a, Show a, ConfigFormat a) => a -> IO (CompileInfo ())@@ -323,3 +355,16 @@             compileError $ "Expected pattern " ++ show p ++ " in error output but got\n" ++ text       | otherwise =           compileError $ "Expected write failure but got\n" ++ getCompileSuccess c++checkParsesAs :: (Show a, ConfigFormat a) => String -> (a -> Bool) -> IO (CompileInfo ())+checkParsesAs f m = do+  contents <- loadFile f+  let parsed = autoReadConfig f contents+  return $ check parsed contents+  where+    check x contents = do+      x' <- x `reviseError` ("While parsing " ++ f)+      when (not $ m x') $+        compileError $ "Failed to match after write/read\n" +++                       "Unparsed:\n" ++ contents ++ "\n" +++                       "Parsed:\n" ++ show x' ++ "\n"

@@ -42,11 +42,26 @@                   [PragmaVisibility _ TestsOnly] -> True                   _ -> False), +    checkParsesAs "$NoTrace$" (fmap (:[]) pragmaNoTrace)+      (\e -> case e of+                  [PragmaTracing _ NoTrace] -> True+                  _ -> False),++    checkParsesAs "$TraceCreation$" (fmap (:[]) pragmaTraceCreation)+      (\e -> case e of+                  [PragmaTracing _ TraceCreation] -> True+                  _ -> False),+     checkParsesAs "$Comment[ \"this is a pragma with args\" ]$" (fmap (:[]) pragmaComment)       (\e -> case e of                   [PragmaComment _ "this is a pragma with args"] -> True                   _ -> False), +    checkParsesAs "$ExprLookup[ \nMODULE_PATH /*comment*/\n ]$" (fmap (:[]) pragmaExprLookup)+      (\e -> case e of+                  [PragmaExprLookup _ "MODULE_PATH"] -> True+                  _ -> False),+     checkParsesAs "/*only comments*/" (parsePragmas [pragmaModuleOnly,pragmaTestsOnly])       (\e -> case e of                   [] -> True@@ -73,7 +88,9 @@      checkParseError "$TestsOnly[ extra ]$" "does not allow arguments" pragmaTestsOnly, -    checkParseError "$Comment$" "requires arguments" pragmaComment+    checkParseError "$Comment$" "requires arguments" pragmaComment,++    checkParseError "$ExprLookup[ \"bad stuff\" ]$" "macro name" pragmaExprLookup   ]  checkParsesAs :: String -> Parser [Pragma SourcePos] -> ([Pragma SourcePos] -> Bool) -> IO (CompileInfo ())

@@ -210,6 +210,11 @@     checkShortParseFail " x <- 'xx'",     checkShortParseSuccess " x <- \"'xx\"", +    checkParsesAs "'\"'"+                  (\e -> case e of+                              (Literal (CharLiteral _ '"')) -> True+                              _ -> False),+     checkParsesAs "1 + 2 < 4 && 3 >= 1 * 2 + 1 || true"                   (\e -> case e of                               (InfixExpression _

@@ -0,0 +1,12 @@+path: "testfiles"+expression_map: [+  expression_macro {+    name: MY_MACRO+    expression: require(empty)+  }+  expression_macro {+    name: MY_OTHER_MACRO+    expression: Type<Int>$execute("this is a string\012")+  }+]+mode: incremental {}

@@ -46,8 +46,7 @@ processPairs f (Positional ps1) (Positional ps2)   | length ps1 == length ps2 =     collectAllOrErrorM $ map (uncurry f) (zip ps1 ps2)-  | otherwise =-    compileError $ "Parameter count mismatch: " ++ show ps1 ++ " vs. " ++ show ps2+  | otherwise = mismatchError ps1 ps2  processPairs_ :: (Show a, Show b, CompileErrorM m) =>   (a -> b -> m c) -> Positional a -> Positional b -> m ()@@ -58,5 +57,8 @@ processPairsT f (Positional ps1) (Positional ps2)   | length ps1 == length ps2 =     sequence $ map (uncurry f) (zip ps1 ps2)-  | otherwise =-    lift $ compileError $ "Parameter count mismatch: " ++ show ps1 ++ " vs. " ++ show ps2+  | otherwise = lift $ mismatchError ps1 ps2++mismatchError :: (Show a, Show b, CompileErrorM m) => [a] -> [b] -> m c+mismatchError ps1 ps2 = compileError $ "Count mismatch: " ++ show ps1 +++                                       " (expected) vs. " ++ show ps2 ++ " (actual)"

@@ -21,19 +21,33 @@ module Types.Pragma (   CodeVisibility(..),   Pragma(..),+  TraceType(..),   getPragmaContext,+  isExprLookup,   isModuleOnly,+  isNoTrace,   isTestsOnly,+  isTraceCreation, ) where   data CodeVisibility = ModuleOnly | TestsOnly deriving (Show) +data TraceType = NoTrace | TraceCreation deriving (Show)+ data Pragma c =   PragmaVisibility {     pvContext :: [c],     pvScopes :: CodeVisibility   } |+  PragmaExprLookup {+    pelContext :: [c],+    pelName :: String+  } |+  PragmaTracing {+    ptContext :: [c],+    ptType :: TraceType+  } |   -- This is mostly for testing purposes.   PragmaComment {     pcContext :: [c],@@ -43,11 +57,25 @@  getPragmaContext :: Pragma c -> [c] getPragmaContext (PragmaVisibility c _) = c+getPragmaContext (PragmaExprLookup c _) = c+getPragmaContext (PragmaTracing c _)    = c getPragmaContext (PragmaComment c _)    = c  isModuleOnly :: Pragma c -> Bool isModuleOnly (PragmaVisibility _ ModuleOnly) = True isModuleOnly _                               = False++isExprLookup :: Pragma c -> Bool+isExprLookup (PragmaExprLookup _ _) = True+isExprLookup _                      = False++isNoTrace :: Pragma c -> Bool+isNoTrace (PragmaTracing _ NoTrace) = True+isNoTrace _                         = False++isTraceCreation :: Pragma c -> Bool+isTraceCreation (PragmaTracing _ TraceCreation) = True+isTraceCreation _                               = False  isTestsOnly :: Pragma c -> Bool isTestsOnly (PragmaVisibility _ TestsOnly) = True

@@ -40,6 +40,7 @@   VariableName(..),   VoidExpression(..),   WhileLoop(..),+  assignableName,   getExpressionContext,   getStatementContext,   isDiscardedInput,@@ -48,6 +49,7 @@  import Data.List (intercalate) +import Types.Pragma import Types.Positional import Types.TypeCategory import Types.TypeInstance@@ -58,6 +60,7 @@ data ExecutableProcedure c =   ExecutableProcedure {     epContext :: [c],+    epPragmas :: [Pragma c],     epEnd :: [c],     epName :: FunctionName,     epArgs :: ArgValues c,@@ -118,6 +121,9 @@ isDiscardedInput (DiscardInput _) = True isDiscardedInput _                = False +discardInputName :: VariableName+discardInputName = VariableName "_"+ instance Show c => Show (InputValue c) where   show (InputValue c v) = show v ++ " /*" ++ formatFullContext c ++ "*/"   show (DiscardInput c) = "_" ++ " /*" ++ formatFullContext c ++ "*/"@@ -162,6 +168,11 @@   ExistingVariable (InputValue c)   deriving (Show) +assignableName :: Assignable c -> VariableName+assignableName (CreateVariable _ _ n)              = n+assignableName (ExistingVariable (InputValue _ n)) = n+assignableName _                                   = discardInputName+ data VoidExpression c =   Conditional (IfElifElse c) |   Loop (WhileLoop c) |@@ -222,6 +233,7 @@  data ExpressionStart c =   NamedVariable (OutputValue c) |+  NamedMacro [c] String |   CategoryCall [c] CategoryName (FunctionCall c) |   TypeCall [c] TypeInstanceOrParam (FunctionCall c) |   UnqualifiedCall [c] (FunctionCall c) |

@@ -165,13 +165,7 @@     formatValue v = show (pfParam v) ++ " " ++ show (pfFilter v) ++                     " " ++ formatContext (pfContext v)     formatInterfaceFunc f = showFunctionInContext "" "  " f-    formatConcreteFunc f = showFunctionInContext (showScope (sfScope f) ++ " ") "  " f--showScope :: SymbolScope -> String-showScope CategoryScope = "@category"-showScope TypeScope     = "@type"-showScope ValueScope    = "@value"-showScope LocalScope    = "@local"+    formatConcreteFunc f = showFunctionInContext (show (sfScope f) ++ " ") "  " f  getCategoryName :: AnyCategory c -> CategoryName getCategoryName (ValueInterface _ _ n _ _ _ _)  = n@@ -358,8 +352,14 @@   CategoryScope |   TypeScope |   ValueScope-  deriving (Eq,Ord,Show)+  deriving (Eq,Ord) +instance Show SymbolScope where+  show CategoryScope = "@category"+  show TypeScope     = "@type"+  show ValueScope    = "@value"+  show LocalScope    = "@local"+ partitionByScope :: (a -> SymbolScope) -> [a] -> ([a],[a],[a]) partitionByScope f = foldr bin empty where   empty = ([],[],[])@@ -846,8 +846,8 @@         where           checkMerge r3 fm3 f1 f2             | sfScope f1 /= sfScope f2 =-              compileError $ "Cannot merge " ++ showScope (sfScope f2) ++ " with " ++-                             showScope (sfScope f1) ++ " in function merge:\n---\n" +++              compileError $ "Cannot merge " ++ show (sfScope f2) ++ " with " +++                             show (sfScope f1) ++ " in function merge:\n---\n" ++                              show f2 ++ "\n  ->\n" ++ show f1             | otherwise =               flip reviseError ("In function merge:\n---\n" ++ show f2 ++@@ -889,7 +889,7 @@   }  instance Show c => Show (ScopedFunction c) where-  show f = showFunctionInContext (showScope (sfScope f) ++ " ") "" f+  show f = showFunctionInContext (show (sfScope f) ++ " ") "" f  showFunctionInContext :: Show c => String -> String -> ScopedFunction c -> String showFunctionInContext s indent (ScopedFunction cs n t _ as rs ps fa ms) =

@@ -275,7 +275,8 @@ checkValueTypeMatch r f ts1@(ValueType r1 t1) ts2@(ValueType r2 t2)   | r1 < r2 =     compileError $ "Cannot convert " ++ show ts1 ++ " to " ++ show ts2-  | otherwise = checkGeneralMatch r f Covariant t1 t2+  | otherwise = checkGeneralMatch r f Covariant t1 t2 `reviseError`+      ("Cannot convert " ++ show ts1 ++ " to " ++ show ts2)  checkGeneralMatch :: (MergeableM m, CompileErrorM m, TypeResolver r) =>   r -> ParamFilters -> Variance ->

@@ -1,5 +1,20 @@ root: ".." path: "tests"+expression_map: [+  // See expr-lookup.0rt and expr-lookup.0rx.+  expression_macro {+    name: INT_EXPR+    expression: 1+3+  }+  expression_macro {+    name: LOCAL_VAR+    expression: macroLocalVar+  }+  expression_macro {+    name: META_VAR+    expression: $ExprLookup[INT_EXPR]$*5+  }+] private_deps: [   "visibility"   "visibility2"

@@ -78,6 +78,16 @@ }  +test_tests_only2() {+  local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/tests-only2 || true)+  if ! echo "$output" | egrep -q 'main.+ Testing'; then+    show_message 'Expected Testing definition error from tests/tests-only:'+    echo "$output" 1>&2+    return 1+  fi+}++ test_module_only() {   local output=$(do_zeolite -p "$ZEOLITE_PATH" -R tests/module-only || true)   if ! echo "$output" | egrep -q 'Type1 not found'; then@@ -115,6 +125,7 @@ define $category {   run () {     \ LazyStream<Formatted>\$new()+        .append(\$ExprLookup[MODULE_PATH]\$ + "\n")         .append("Hello World\n")         .writeTo(SimpleOutput\$stdout())   }@@ -127,6 +138,11 @@     echo "$output" 1>&2     return 1   fi+  if ! echo "$output" | fgrep -xq "$PWD"; then+    show_message 'Expected $PWD in program output:'+    echo "$output" 1>&2+    return 1+  fi   execute rm -r "$temp" "$PWD/$category" || true } @@ -165,22 +181,44 @@ }  +test_example_hello() {+  do_zeolite -p "$ZEOLITE_PATH" -i lib/util -m HelloDemo example/hello -f+  do_zeolite -p "$ZEOLITE_PATH" -t example/hello+}+++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+}++ run_all() {   ZEOLITE_PATH=$(do_zeolite --get-path | grep '^/')   echo 1>&2   local failed=0+  local list=()   for t in "$@"; do     show_message "Testing $t >>>"     echo 1>&2     if ! "$t"; then       failed=1+      list=("${list[@]}" "$t")     fi     echo 1>&2     show_message "<<< Testing $t"     echo 1>&2   done   if (($failed)); then-    show_message 'One or more tests failed.'+    for t in "${list[@]}"; do+      show_message "*** $t FAILED ***"+    done     return 1   else     show_message 'All tests passed.'@@ -190,11 +228,15 @@ ALL_TESTS=(   test_check_defs   test_tests_only+  test_tests_only2   test_module_only   test_templates   test_fast   test_bad_system_include   test_global_include+  test_example_hello+  test_example_tree+  test_example_parser )  run_all "${ALL_TESTS[@]}" 1>&2

@@ -0,0 +1,26 @@+/* -----------------------------------------------------------------------------+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]++$ModuleOnly$+$TestsOnly$++concrete ExprLookup {+  @type modulePath () -> (String)+  @type intExpr () -> (Int)+  @type localVar () -> (Int)+}

@@ -0,0 +1,205 @@+/* -----------------------------------------------------------------------------+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 "bad macro name" {+  error+  require "UNKNOWN_STRING .+not defined"+}++define Test {+  run () {+    String value <- $ExprLookup[UNKNOWN_STRING]$+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "MODULE_PATH is absolute" {+  crash Test$run()+  require "Failed condition: /.+/tests"+}++define Test {+  run () {+    fail($ExprLookup[MODULE_PATH]$)+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "MODULE_PATH from regular source" {+  crash Test$run()+  require "Failed condition: /.+/tests"+}++define Test {+  run () {+    fail(ExprLookup$modulePath())+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "mismatched macro type" {+  error+  require "String.+Int"+}++define Test {+  run () {+    Int value <- $ExprLookup[MODULE_PATH]$+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "macro used inline in expressions" {+  crash Test$run()+  require "Failed condition: /.+/tests is the path"+}++define Test {+  run () {+    fail($ExprLookup[MODULE_PATH]$ + " is the path")+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "constant defined in .zeolite-module" {+  success Test$run()+}++define Test {+  run () {+    \ Testing$check<Int>($ExprLookup[INT_EXPR]$,4)+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "constant defined in .zeolite-module from regular source" {+  success Test$run()+}++define Test {+  run () {+    \ Testing$check<Int>(ExprLookup$intExpr(),4)+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "in context defined in .zeolite-module" {+  success Test$run()+}++define Test {+  @category String macroLocalVar <- "hello"++  run () {+    \ Testing$check<String>($ExprLookup[LOCAL_VAR]$,"hello")+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "undefined in context defined in .zeolite-module" {+  error+  require "\.zeolite-module"+  require "macroLocalVar"+}++define Test {+  run () {+    String value <- $ExprLookup[LOCAL_VAR]$+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "in context defined in .zeolite-module from regular source" {+  success Test$run()+}++define Test {+  run () {+    \ Testing$check<Int>(ExprLookup$localVar(),99)+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "nested expression defined in .zeolite-module" {+  success Test$run()+}++define Test {+  run () {+    \ Testing$check<Int>($ExprLookup[META_VAR]$,20)+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "function called on expression" {+  success Test$run()+}++define Test {+  run () {+    \ Testing$check<String>($ExprLookup[INT_EXPR]$.formatted(),"4")+  }+}++concrete Test {+  @type run () -> ()+}

@@ -0,0 +1,34 @@+/* -----------------------------------------------------------------------------+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]++$TestsOnly$++define ExprLookup {+  modulePath () {+    return $ExprLookup[MODULE_PATH]$+  }++  intExpr () {+    return $ExprLookup[INT_EXPR]$+  }++  localVar () {+    Int macroLocalVar <- 99+    return $ExprLookup[LOCAL_VAR]$+  }+}

@@ -93,6 +93,29 @@ }  +testcase "@category member refers to @category member" {+  success Test$run()+}++define Test {+  @category Int value1 <- 1+  @category Int value2 <- value1+1++  @category get () -> (Int)+  get () {+    return value2+  }++  run () {+    \ Testing$check<Int>(get(),2)+  }+}++concrete Test {+  @type run () -> ()+}++ testcase "@category member is lazy" {   success Test$run() }

@@ -1,4 +1,4 @@-# `$TestsOnly$` Pragma Test+# `$TestsOnly$` Visibility Test - Incremental  Compiling this module should **always fail**. It tests that the `$TestsOnly$` pragma limits visibility to only `.0rx` sources that also have the `$TestsOnly$`

@@ -0,0 +1,6 @@+root: "../.."+path: "tests/tests-only2"+mode: binary {+  category: Testing+  function: run+}

@@ -0,0 +1,18 @@+# `$TestsOnly$` Visibility Test - Binaries++Compiling this module should **always fail**. It tests that the `$TestsOnly$`+pragma limits visibility of `.0rx` categories to only test binaries.++To compile:++```shell+ZEOLITE_PATH=$(zeolite --get-path)+zeolite -p $ZEOLITE_PATH -r tests/tests-only2+```++The compiler errors should look something like this:++```text+Compiler errors:+No matches for main category Testing ($TestsOnly$ sources excluded)+```

@@ -0,0 +1,23 @@+/* -----------------------------------------------------------------------------+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]++$TestsOnly$++define Testing {+  run () {}+}

@@ -0,0 +1,23 @@+/* -----------------------------------------------------------------------------+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]++$TestsOnly$++concrete Testing {+  @type run () -> ()+}

@@ -0,0 +1,177 @@+/* -----------------------------------------------------------------------------+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 "NoTrace skips tracing" {+  crash Test$run()+  require "message"+  require "Test\.run"+  require "Test\.error"+  exclude "Test\.noTrace"+}++define Test {+  run () {+    \ noTrace()+  }++  @type noTrace () -> ()+  noTrace () { $NoTrace$+    \ error()+  }++  @type error () -> ()+  error () {+    fail("message")+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "TraceCreation captures trace" {+  crash Test$run()+  require "message"+  require "Type.+created at"+}++concrete Type {+  @type create () -> (Type)+  @value call () -> ()+}++define Type {+  create () {+    return Type{ }+  }++  call ()  { $TraceCreation$+    fail("message")+  }+}++define Test {+  run () {+    Type value <- Type$create()+    \ value.call()+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "TraceCreation ignored in @type" {+  success Test$run()+  require compiler "tracing ignored"+}++define Test {+  run () { $TraceCreation$ }+}++concrete Test {+  @type run () -> ()+}+++testcase "TraceCreation still works with NoTrace" {+  crash Test$run()+  require "message"+  require "Type.+created at"+  exclude "Type\.call"+}++concrete Type {+  @type create () -> (Type)+  @value call () -> ()+}++define Type {+  create () {+    return Type{ }+  }++  call ()  { $NoTrace$ $TraceCreation$+    fail("message")+  }+}++define Test {+  run () {+    Type value <- Type$create()+    \ value.call()+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "TraceCreation only uses the latest" {+  crash Test$run()+  require "message"+  require "Type1.+created at"+  exclude "Type2.+created at"+}++concrete Type1 {+  @type create () -> (Type1)+  @value call () -> ()+}++define Type1 {+  create () {+    return Type1{ }+  }++  call ()  { $TraceCreation$+    fail("message")+  }+}++concrete Type2 {+  @type create () -> (Type2)+  @value call () -> ()+}++define Type2 {+  @value Type1 value++  create () {+    return Type2{ Type1$create() }+  }++  call ()  { $TraceCreation$+    \ value.call()+  }+}++define Test {+  run () {+    Type2 value <- Type2$create()+    \ value.call()+  }+}++concrete Test {+  @type run () -> ()+}

@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                zeolite-lang-version:             0.5.0.0+version:             0.6.0.0 synopsis:            Zeolite is a statically-typed, general-purpose programming language.  description:@@ -62,7 +62,8 @@ extra-source-files:  ChangeLog.md,                      src/Test/testfiles/*.0rp,                      src/Test/testfiles/*.0rt,-                     src/Test/testfiles/*.0rx+                     src/Test/testfiles/*.0rx,+                     src/Test/testfiles/*.txt  data-files:          base/.zeolite-module,                      base/*.0rp,@@ -72,10 +73,12 @@                      base/*.h,                      example/hello/README.md,                      example/hello/*.0rx,-                     example/regex/README.md,-                     example/regex/*.0rp,-                     example/regex/*.0rt,-                     example/regex/*.0rx,+                     example/parser/.zeolite-module,+                     example/parser/README.md,+                     example/parser/*.0rp,+                     example/parser/*.0rt,+                     example/parser/*.0rx,+                     example/parser/*.txt,                      example/tree/README.md,                      example/tree/*.0rp,                      example/tree/*.0rt,@@ -115,6 +118,10 @@                      tests/tests-only/.zeolite-module,                      tests/tests-only/*.0rp,                      tests/tests-only/*.0rx,+                     tests/tests-only2/README.md,+                     tests/tests-only2/.zeolite-module,+                     tests/tests-only2/*.0rp,+                     tests/tests-only2/*.0rx,                      tests/visibility/.zeolite-module,                      tests/visibility/*.0rp,                      tests/visibility/*.0rx,