derive impls where possible
This commit is contained in:
parent
274ecfb58c
commit
cde2a9b0d6
|
|
@ -3,14 +3,15 @@ module Quox.Equal
|
|||
import public Quox.Syntax
|
||||
import public Quox.Reduce
|
||||
import Control.Monad.Either
|
||||
import Generics.Derive
|
||||
|
||||
%default total
|
||||
%language ElabReflection
|
||||
|
||||
|
||||
public export
|
||||
data Mode = Equal | Sub
|
||||
|
||||
export %inline Show Mode where show Equal = "Equal"; show Sub = "Sub"
|
||||
%runElab derive "Mode" [Generic, Meta, Eq, Ord, DecEq, Show]
|
||||
|
||||
public export
|
||||
data Error
|
||||
|
|
|
|||
|
|
@ -2,22 +2,18 @@ module Quox.Name
|
|||
|
||||
import public Data.SnocList
|
||||
import Data.List
|
||||
import Generics.Derive
|
||||
|
||||
%hide TT.Name
|
||||
|
||||
%default total
|
||||
%language ElabReflection
|
||||
|
||||
|
||||
public export
|
||||
data BaseName =
|
||||
UN String -- user-given name
|
||||
|
||||
private BRepr : Type
|
||||
BRepr = String
|
||||
|
||||
private %inline brepr : BaseName -> BRepr
|
||||
brepr (UN x) = x
|
||||
|
||||
export Eq BaseName where (==) = (==) `on` brepr
|
||||
export Ord BaseName where compare = compare `on` brepr
|
||||
data BaseName
|
||||
= UN String -- user-given name
|
||||
%runElab derive "BaseName" [Generic, Meta, Eq, Ord, DecEq]
|
||||
|
||||
export
|
||||
Show BaseName where
|
||||
|
|
@ -38,15 +34,7 @@ record Name where
|
|||
constructor MakeName
|
||||
mods : SnocList String
|
||||
base : BaseName
|
||||
|
||||
private Repr : Type
|
||||
Repr = (SnocList String, BRepr)
|
||||
|
||||
private %inline repr : Name -> Repr
|
||||
repr x = (x.mods, brepr x.base)
|
||||
|
||||
export Eq Name where (==) = (==) `on` repr
|
||||
export Ord Name where compare = compare `on` repr
|
||||
%runElab derive "Name" [Generic, Meta, Eq, Ord]
|
||||
|
||||
export
|
||||
Show Name where
|
||||
|
|
|
|||
|
|
@ -10,8 +10,12 @@ import Data.DPair
|
|||
|
||||
import public Control.Monad.Identity
|
||||
import public Control.Monad.Reader
|
||||
import Generics.Derive
|
||||
|
||||
%default total
|
||||
%language ElabReflection
|
||||
|
||||
%hide TT.Name
|
||||
|
||||
|
||||
public export
|
||||
|
|
@ -26,58 +30,23 @@ defPrettyOpts = MakePrettyOpts {unicode = True, color = True}
|
|||
|
||||
public export
|
||||
data HL
|
||||
= Delim
|
||||
| TVar
|
||||
| TVarErr
|
||||
| Dim
|
||||
| DVar
|
||||
| DVarErr
|
||||
| Qty
|
||||
| Free
|
||||
| Syntax
|
||||
|
||||
private HLRepr : Type
|
||||
HLRepr = Nat
|
||||
|
||||
private %inline hlRepr : HL -> Nat
|
||||
hlRepr Delim = 0
|
||||
hlRepr TVar = 1
|
||||
hlRepr TVarErr = 2
|
||||
hlRepr Dim = 3
|
||||
hlRepr DVar = 4
|
||||
hlRepr DVarErr = 5
|
||||
hlRepr Qty = 6
|
||||
hlRepr Free = 7
|
||||
hlRepr Syntax = 8
|
||||
|
||||
export %inline Eq HL where (==) = (==) `on` hlRepr
|
||||
export %inline Ord HL where compare = compare `on` hlRepr
|
||||
|
||||
= Delim
|
||||
| Free | TVar | TVarErr
|
||||
| Dim | DVar | DVarErr
|
||||
| Qty
|
||||
| Syntax
|
||||
%runElab derive "HL" [Generic, Meta, Eq, Ord, DecEq, Show]
|
||||
|
||||
public export
|
||||
data PPrec
|
||||
= Outer
|
||||
| Ann -- right of "::"
|
||||
| AnnL -- left of "::"
|
||||
= Outer
|
||||
| Ann -- right of "::"
|
||||
| AnnL -- left of "::"
|
||||
-- ...
|
||||
| App -- term/dimension application
|
||||
| SApp -- substitution application
|
||||
| Arg -- argument to nonfix function
|
||||
|
||||
private PrecRepr : Type
|
||||
PrecRepr = Nat
|
||||
|
||||
private %inline precRepr : PPrec -> PrecRepr
|
||||
precRepr Outer = 0
|
||||
precRepr Ann = 1
|
||||
precRepr AnnL = 2
|
||||
-- ...
|
||||
precRepr App = 98
|
||||
precRepr SApp = 99
|
||||
precRepr Arg = 100
|
||||
|
||||
export %inline Eq PPrec where (==) = (==) `on` precRepr
|
||||
export %inline Ord PPrec where compare = compare `on` precRepr
|
||||
| App -- term/dimension application
|
||||
| SApp -- substitution application
|
||||
| Arg -- argument to nonfix function
|
||||
%runElab derive "PPrec" [Generic, Meta, Eq, Ord, DecEq, Show]
|
||||
|
||||
|
||||
export %inline
|
||||
|
|
@ -100,6 +69,7 @@ hlF' = map . hl'
|
|||
export %inline
|
||||
parens : Doc HL -> Doc HL
|
||||
parens doc = hl Delim "(" <+> doc <+> hl Delim ")"
|
||||
%hide Symbols.parens
|
||||
|
||||
export %inline
|
||||
parensIf : Bool -> Doc HL -> Doc HL
|
||||
|
|
@ -138,7 +108,8 @@ record PrettyEnv where
|
|||
||| surrounding precedence level
|
||||
prec : PPrec
|
||||
|
||||
public export HasEnv : (Type -> Type) -> Type
|
||||
public export
|
||||
HasEnv : (Type -> Type) -> Type
|
||||
HasEnv = MonadReader PrettyEnv
|
||||
|
||||
export %inline
|
||||
|
|
|
|||
|
|
@ -17,9 +17,6 @@ public export
|
|||
data DimConst = Zero | One
|
||||
%name DimConst e
|
||||
|
||||
private DCRepr : Type
|
||||
DCRepr = Nat
|
||||
|
||||
%runElab derive "DimConst" [Generic, Meta, Eq, Ord, DecEq, Show]
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,6 @@ data Punc
|
|||
| Arrow | DblArrow
|
||||
| Times | Triangle
|
||||
| Wild
|
||||
|
||||
%runElab derive "Punc" [Generic, Meta, Eq, Ord, DecEq, Show]
|
||||
|
||||
|
||||
|
|
@ -26,7 +25,6 @@ public export
|
|||
data Keyword
|
||||
= Lam | Let | In | Case | Of | Omega
|
||||
| Pi | Sigma | W
|
||||
|
||||
%runElab derive "Keyword" [Generic, Meta, Eq, Ord, DecEq, Show]
|
||||
|
||||
|
||||
|
|
@ -34,7 +32,6 @@ data Keyword
|
|||
||| quantity & dimension constants
|
||||
public export
|
||||
data Number = Zero | One | Other Nat
|
||||
|
||||
%runElab derive "Number" [Generic, Meta, Eq, Ord, DecEq, Show]
|
||||
|
||||
|
||||
|
|
@ -44,7 +41,6 @@ data Token
|
|||
| K Keyword
|
||||
| Name String | Symbol String
|
||||
| N Number | TYPE Nat
|
||||
|
||||
%runElab derive "Token" [Generic, Meta, Eq, Ord, DecEq, Show]
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue