tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

consumer_choose_contract.tri (1253B)

      1 -- A tree Boolean has exactly two inhabitants in SCP: leaf and stem leaf.
      2 !import "consumers.base-source" B
      3 !import "consumers.structural" S
      4 !import "consumers.lexical-worker" L
      5 !import "consumers.validate" V
      6 !import "prelude" !Local
      7 source = "consumer truth\n  x @ _ => choose x 1 0"
      8 program = snd (resultOr t (B.compileBaseSource source))
      9 compiled = L.lCompile program
     10 -- Output tag 7 is no longer authored IR, even when its old payload is valid.
     11 removedTag = S.makeConsumer t [(S.makeRule S.patAny S.patAny
     12   (pair 7 (pair (S.outLiteral true)
     13     (pair (S.outLiteral 1) (S.outLiteral 0)))))]
     14 same input expected = (and?
     15   (equal? (S.runConsumer program input) expected)
     16   (equal? (L.lRunChecked (resultOr t compiled) input) expected))
     17 checks = foldl and? true [
     18   (resultIsOk compiled)
     19   (equal? (V.vValidate removedTag)
     20     (err (V.vDiagnostic "malformed" 0 ["output"] "unknown output tag") t))
     21   (equal? (L.lCompile removedTag) (V.vValidate removedTag))
     22   (equal? (S.runConsumer removedTag t) (err "unknown output form" t))
     23   (same false (ok 0 t))
     24   (same true (ok 1 t))
     25   (same (t 7) (err "no matching output arm" t))
     26   (same (pair t t) (err "no matching output arm" t))]
     27 main = matchBool "choose-contract-ok" "choose-contract-DIFFER" checks
     28 main