Tricu 2.0.0

Sorry for squashing all of this but 🤷
2026-05-25 12:43:15 -05:00
parent 2e2db07bd6
commit fdebb6c13d
105 changed files with 10139 additions and 1938 deletions
--- a/demos/viewContracts/complete.tri
+++ b/demos/viewContracts/complete.tri
@@ -0,0 +1,119 @@
+!import "prelude" !Local
+!import "view" !Local
+
+-- Complete explicit View Contract demo.
+-- Run with: tricu eval demos/viewContracts/complete.tri -f decode
+--
+-- This file uses the low-level portable typed-program builders directly. It is
+-- useful for understanding what source annotations lower to. For the end-user
+-- guide, see demos/viewContracts.tri.
+
+requireNonEmpty = (xs :
+  lazyBool
+    (_ : guardFail)
+    (_ : guardOk xs)
+    (emptyList? xs))
+
+NonEmptyList = (elemView :
+  viewGuarded (viewList elemView) requireNonEmpty)
+
+checkedResult = (result :
+  matchResult
+    (diag env : renderDiagnostic diag)
+    (exec env :
+      matchResult
+        (runtimeDiag runtimeEnv : renderDiagnostic runtimeDiag)
+        (value runtimeEnv : value)
+        (runChecked exec))
+    result)
+
+checkedContract = (program :
+  checkedResult (checkTypedProgramWith policyStrict program))
+
+plainViewFailure =
+  matchResult
+    (diag env : renderDiagnostic diag)
+    (exec env : "unexpected-ok")
+    (checkTypedProgramWith
+      policyStrict
+      (typedProgram
+        0
+        [(typedValue 0 (viewList viewString) [("Ada")])
+         (typedRequire 0 (viewList viewBool) t)]))
+
+nonEmptyRootSuccess =
+  matchBool
+    "ok"
+    "unexpected-value"
+    (equal?
+      (checkedContract
+        (typedProgram
+          0
+          [(typedValue 0 (NonEmptyList viewString) [("Ada") ("Grace")])]))
+      [("Ada") ("Grace")])
+
+nonEmptyRootFailure =
+  checkedContract
+    (typedProgram
+      0
+      [(typedValue 0 (viewList viewString) [])
+       (typedRequire 0 (NonEmptyList viewString) [])])
+
+firstNameSuccess =
+  checkedContract
+    (typedProgram
+      2
+      [(typedValue 0 (viewFn [(NonEmptyList viewString)] viewString) (xs : head xs))
+       (typedValue 1 (viewList viewString) [("Ada") ("Grace")])
+       (typedApply 2 0 1 "Ada")
+       (typedRequire 2 viewString "Ada")])
+
+firstNameFailure =
+  checkedContract
+    (typedProgram
+      2
+      [(typedValue 0 (viewFn [(NonEmptyList viewString)] viewString) (xs : head xs))
+       (typedValue 1 (viewList viewString) [])
+       (typedApply 2 0 1 t)
+       (typedRequire 2 viewString t)])
+
+resultGuardFailure =
+  checkedContract
+    (typedProgram
+      2
+      [(typedValue 0 (viewFn [(viewString)] (NonEmptyList viewString)) (name : []))
+       (typedValue 1 viewString "Ada")
+       (typedApply 2 0 1 [])])
+
+observationComposition =
+  checkedContract
+    (typedProgram
+      0
+      [(typedValue 0 viewString "Ada")
+       (typedRequire 0 (viewGuarded viewString (x : guardOk (append x " Lovelace"))) "Ada")
+       (typedRequire 0 (viewGuarded viewString (x : guardOk (append x "!"))) "Ada")])
+
+unreachableGuard =
+  checkedContract
+    (typedProgram
+      0
+      [(typedValue 0 viewString "only the root is checked")
+       (typedValue 1 (viewList viewString) [])
+       (typedRequire 1 (NonEmptyList viewString) [])])
+
+malformedGuard =
+  checkedContract
+    (typedProgram
+      0
+      [(typedValue 0 (viewGuarded viewString (x : record 99 t)) "bad guard")])
+
+main = [
+  (append "plain View structural failure: " plainViewFailure)
+  (append "NonEmptyList root success: " nonEmptyRootSuccess)
+  (append "NonEmptyList root failure: " nonEmptyRootFailure)
+  (append "NonEmptyList function argument success: " firstNameSuccess)
+  (append "NonEmptyList function argument failure: " firstNameFailure)
+  (append "NonEmptyList function result failure: " resultGuardFailure)
+  (append "guard observations compose: " observationComposition)
+  (append "unreachable guard does not run: " unreachableGuard)
+  (append "malformed guard result: " malformedGuard)]