!import "prelude" !Local

-- Structural contracts that exploit Tree Calculus's intensional nature.
-- These are not simple type tags; they recursively inspect the tree shape.

-- Any value that is not Leaf.
nonEmptyTree? = guardC "empty tree" (x : not? (isZero? x))

-- Every internal node is a Fork with two children; Stems are not allowed.
fullTree? = guardC "not a full binary tree"
  (y (self x :
    triage
      true
      (_ : false)
      (l r : and? (self l) (self r))
      x))

-- Even and odd number contracts that inspect the LSB bit tree.
evenC? = guardC "not even" even?
oddC?  = guardC "not odd" odd?

-- A power of two has exactly one '1' bit in its LSB encoding.
powerOfTwo? = guardC "not a power of two"
  (y (self n :
    triage
      false
      true
      (bit rest :
        matchBool
          (self rest)
          false
          (isZero? bit))
      n))

-- A string (list of numbers) where every code point is in the ASCII range.
asciiString? = listOf
  (guardC "non-ascii byte" (n : and? (gte? n 0) (lte? n 127)))

-- Check that a list of numbers is sorted in ascending order.
-- The element contract parameter is applied separately by listOf.
isSorted_ = (self xs :
  matchList
    true
    (h r :
      matchBool
        (self r)
        false
        (matchList true (h2 _ : lte? h h2) r))
    xs)

isSorted = y isSorted_

sortedList? = (c : andC (listOf c) (guardC "not sorted" isSorted))