2021-07-20 16:05:19 -04:00
|
|
|
|
module Quox.Syntax.Qty
|
|
|
|
|
|
|
|
|
|
|
|
import Quox.Pretty
|
|
|
|
|
|
|
|
|
|
|
|
import Data.Fin
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
public export
|
|
|
|
|
|
data Qty = Zero | One | Many
|
|
|
|
|
|
%name Qty.Qty pi, rh
|
|
|
|
|
|
|
|
|
|
|
|
private Repr : Type
|
|
|
|
|
|
Repr = Fin 3
|
|
|
|
|
|
|
|
|
|
|
|
private %inline repr : Qty -> Repr
|
|
|
|
|
|
repr pi = case pi of Zero => 0; One => 1; Many => 2
|
|
|
|
|
|
|
|
|
|
|
|
export Eq Qty where (==) = (==) `on` repr
|
|
|
|
|
|
export Ord Qty where compare = compare `on` repr
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
export
|
|
|
|
|
|
PrettyHL Qty where
|
|
|
|
|
|
prettyM pi = hl Qty <$>
|
|
|
|
|
|
case pi of
|
|
|
|
|
|
Zero => ifUnicode "𝟬" "0"
|
|
|
|
|
|
One => ifUnicode "𝟭" "1"
|
|
|
|
|
|
Many => ifUnicode "𝛚" "*"
|
|
|
|
|
|
|
|
|
|
|
|
export %inline
|
2021-09-03 09:00:16 -04:00
|
|
|
|
prettyQtyBinds : Pretty.HasEnv m => List Qty -> m (Doc HL)
|
2021-07-20 16:05:19 -04:00
|
|
|
|
prettyQtyBinds =
|
|
|
|
|
|
map (align . sep) .
|
|
|
|
|
|
traverse (\pi => [|pretty0M pi <++> pure (hl Delim "|")|])
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
public export
|
|
|
|
|
|
(+) : Qty -> Qty -> Qty
|
|
|
|
|
|
Zero + rh = rh
|
|
|
|
|
|
pi + Zero = pi
|
|
|
|
|
|
_ + _ = Many
|
|
|
|
|
|
|
|
|
|
|
|
public export
|
|
|
|
|
|
(*) : Qty -> Qty -> Qty
|
|
|
|
|
|
Zero * _ = Zero
|
|
|
|
|
|
_ * Zero = Zero
|
|
|
|
|
|
One * rh = rh
|
|
|
|
|
|
pi * One = pi
|
|
|
|
|
|
Many * Many = Many
|
|
|
|
|
|
|
|
|
|
|
|
infix 6 <=.
|
|
|
|
|
|
public export
|
|
|
|
|
|
(<=.) : Qty -> Qty -> Bool
|
|
|
|
|
|
pi <=. rh = rh == Many || pi == rh
|
