85 lines
1.5 KiB
Idris
85 lines
1.5 KiB
Idris
module Quox.Syntax.Qty
|
||
|
||
import Quox.Pretty
|
||
|
||
import Data.Fin
|
||
|
||
%default total
|
||
|
||
|
||
public export
|
||
data Qty = Zero | One | Any
|
||
%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; Any => 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"
|
||
Any => ifUnicode "𝛚" "*"
|
||
|
||
private
|
||
commas : List (Doc HL) -> List (Doc HL)
|
||
commas [] = []
|
||
commas [x] = [x]
|
||
commas (x::xs) = (x <+> hl Delim ",") :: commas xs
|
||
|
||
export %inline
|
||
prettyQtyBinds : Pretty.HasEnv m => List Qty -> m (Doc HL)
|
||
prettyQtyBinds =
|
||
map ((hl Delim "@" <++>) . align . sep . commas) . traverse pretty0M
|
||
|
||
|
||
public export
|
||
plus : Qty -> Qty -> Qty
|
||
plus Zero rh = rh
|
||
plus pi Zero = pi
|
||
plus _ _ = Any
|
||
|
||
public export
|
||
times : Qty -> Qty -> Qty
|
||
times Zero _ = Zero
|
||
times _ Zero = Zero
|
||
times One rh = rh
|
||
times pi One = pi
|
||
times Any Any = Any
|
||
|
||
infix 6 <=.
|
||
public export
|
||
compat : Qty -> Qty -> Bool
|
||
compat pi rh = rh == Any || pi == rh
|
||
|
||
|
||
public export
|
||
interface IsQty q where
|
||
zero, one : q
|
||
(+), (*) : q -> q -> q
|
||
(<=.) : q -> q -> Bool
|
||
|
||
public export
|
||
IsQty Qty where
|
||
zero = Zero; one = One
|
||
(+) = plus; (*) = times
|
||
(<=.) = compat
|
||
|
||
|
||
public export
|
||
data IsSubj : Qty -> Type where
|
||
SZero : IsSubj Zero
|
||
SOne : IsSubj One
|
||
|
||
public export
|
||
data IsGlobal : Qty -> Type where
|
||
GZero : IsGlobal Zero
|
||
GAny : IsGlobal Any
|