2021-07-20 16:05:19 -04:00
|
|
|
module Quox.Syntax.Qty
|
|
|
|
|
|
|
|
import Quox.Pretty
|
2023-02-13 16:05:27 -05:00
|
|
|
import Quox.Name
|
2023-01-09 17:43:23 -05:00
|
|
|
import public Quox.Decidable
|
2023-01-08 14:44:25 -05:00
|
|
|
import Data.DPair
|
2021-07-20 16:05:19 -04:00
|
|
|
|
2022-05-02 16:38:37 -04:00
|
|
|
%default total
|
2021-07-20 16:05:19 -04:00
|
|
|
|
|
|
|
|
2021-12-23 09:50:19 -05:00
|
|
|
private
|
|
|
|
commas : List (Doc HL) -> List (Doc HL)
|
2023-01-08 14:44:25 -05:00
|
|
|
commas [] = []
|
|
|
|
commas [x] = [x]
|
2021-12-23 09:50:19 -05:00
|
|
|
commas (x::xs) = (x <+> hl Delim ",") :: commas xs
|
|
|
|
|
2023-01-26 13:54:46 -05:00
|
|
|
private %inline
|
|
|
|
blobD : Pretty.HasEnv m => m (Doc HL)
|
|
|
|
blobD = hlF Delim $ ifUnicode "·" "@"
|
|
|
|
|
2021-07-20 16:05:19 -04:00
|
|
|
export %inline
|
2023-02-13 16:05:27 -05:00
|
|
|
prettyQtyBinds : Pretty.HasEnv m => PrettyHL q => PrettyHL a =>
|
|
|
|
List q -> a -> m (Doc HL)
|
|
|
|
prettyQtyBinds [] x = pretty0M x
|
|
|
|
prettyQtyBinds qtys x = pure $
|
|
|
|
hang 2 $ sep [aseparate comma !(traverse pretty0M qtys) <++> !blobD,
|
|
|
|
!(pretty0M x)]
|
2021-07-20 16:05:19 -04:00
|
|
|
|
|
|
|
|
|
|
|
public export
|
2023-01-08 14:44:25 -05:00
|
|
|
interface Eq q => IsQty q where
|
2021-09-09 17:51:45 -04:00
|
|
|
zero, one : q
|
|
|
|
(+), (*) : q -> q -> q
|
2022-04-27 16:57:56 -04:00
|
|
|
|
2023-01-08 14:44:25 -05:00
|
|
|
||| true if bindings of this quantity will be erased
|
|
|
|
||| and must not be runtime relevant
|
2023-01-09 17:43:23 -05:00
|
|
|
IsZero : Pred q
|
|
|
|
isZero : Dec1 IsZero
|
2023-01-08 14:44:25 -05:00
|
|
|
zeroIsZero : IsZero zero
|
|
|
|
|
|
|
|
||| ``p `Compat` q`` if it is ok for a binding of
|
|
|
|
||| quantity `q` to be used exactly `p` times.
|
|
|
|
||| e.g. ``1 `Compat` 1``, ``1 `Compat` ω``
|
2023-01-09 17:43:23 -05:00
|
|
|
Compat : Rel q
|
|
|
|
compat : Dec2 Compat
|
2023-01-08 14:44:25 -05:00
|
|
|
|
|
|
|
||| true if it is ok for this quantity to appear for the
|
|
|
|
||| subject of a typing judgement. this is about the
|
|
|
|
||| subject reduction stuff in atkey
|
2023-01-09 17:43:23 -05:00
|
|
|
IsSubj : Pred q
|
|
|
|
isSubj : Dec1 IsSubj
|
2023-01-08 14:44:25 -05:00
|
|
|
zeroIsSubj : IsSubj zero
|
|
|
|
oneIsSubj : IsSubj one
|
2023-01-09 17:43:55 -05:00
|
|
|
timesSubj : forall pi, rh. IsSubj pi -> IsSubj rh -> IsSubj (pi * rh)
|
2023-01-08 14:44:25 -05:00
|
|
|
|
|
|
|
||| true if it is ok for a global definition to have this
|
|
|
|
||| quantity. so not exact usage counts, maybe.
|
2023-01-09 17:43:23 -05:00
|
|
|
IsGlobal : Pred q
|
|
|
|
isGlobal : Dec1 IsGlobal
|
2023-01-08 14:44:25 -05:00
|
|
|
zeroIsGlobal : IsGlobal zero
|
2022-04-27 16:57:56 -04:00
|
|
|
|
|
|
|
public export
|
2023-01-08 14:44:25 -05:00
|
|
|
0 SQty : (q : Type) -> IsQty q => Type
|
|
|
|
SQty q = Subset q IsSubj
|
2022-04-27 16:57:56 -04:00
|
|
|
|
2023-01-08 14:44:25 -05:00
|
|
|
public export %inline
|
|
|
|
szero : IsQty q => SQty q
|
|
|
|
szero = Element zero zeroIsSubj
|
|
|
|
|
|
|
|
public export %inline
|
|
|
|
sone : IsQty q => SQty q
|
|
|
|
sone = Element one oneIsSubj
|
2022-08-22 04:07:46 -04:00
|
|
|
|
2022-04-27 16:57:56 -04:00
|
|
|
public export
|
2023-01-08 14:44:25 -05:00
|
|
|
0 GQty : (q : Type) -> IsQty q => Type
|
|
|
|
GQty q = Subset q IsGlobal
|
|
|
|
|
|
|
|
public export %inline
|
|
|
|
gzero : IsQty q => GQty q
|
|
|
|
gzero = Element zero zeroIsGlobal
|