derive impls where possible

This commit is contained in:
rhiannon morris 2022-05-13 07:05:55 +02:00
parent 274ecfb58c
commit cde2a9b0d6
5 changed files with 31 additions and 78 deletions

View file

@ -3,14 +3,15 @@ module Quox.Equal
import public Quox.Syntax import public Quox.Syntax
import public Quox.Reduce import public Quox.Reduce
import Control.Monad.Either import Control.Monad.Either
import Generics.Derive
%default total %default total
%language ElabReflection
public export public export
data Mode = Equal | Sub data Mode = Equal | Sub
%runElab derive "Mode" [Generic, Meta, Eq, Ord, DecEq, Show]
export %inline Show Mode where show Equal = "Equal"; show Sub = "Sub"
public export public export
data Error data Error

View file

@ -2,22 +2,18 @@ module Quox.Name
import public Data.SnocList import public Data.SnocList
import Data.List import Data.List
import Generics.Derive
%hide TT.Name
%default total %default total
%language ElabReflection
public export public export
data BaseName = data BaseName
UN String -- user-given name = UN String -- user-given name
%runElab derive "BaseName" [Generic, Meta, Eq, Ord, DecEq]
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
export export
Show BaseName where Show BaseName where
@ -38,15 +34,7 @@ record Name where
constructor MakeName constructor MakeName
mods : SnocList String mods : SnocList String
base : BaseName base : BaseName
%runElab derive "Name" [Generic, Meta, Eq, Ord]
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
export export
Show Name where Show Name where

View file

@ -10,8 +10,12 @@ import Data.DPair
import public Control.Monad.Identity import public Control.Monad.Identity
import public Control.Monad.Reader import public Control.Monad.Reader
import Generics.Derive
%default total %default total
%language ElabReflection
%hide TT.Name
public export public export
@ -26,58 +30,23 @@ defPrettyOpts = MakePrettyOpts {unicode = True, color = True}
public export public export
data HL data HL
= Delim = Delim
| TVar | Free | TVar | TVarErr
| TVarErr | Dim | DVar | DVarErr
| Dim | Qty
| DVar | Syntax
| DVarErr %runElab derive "HL" [Generic, Meta, Eq, Ord, DecEq, Show]
| 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
public export public export
data PPrec data PPrec
= Outer = Outer
| Ann -- right of "::" | Ann -- right of "::"
| AnnL -- left of "::" | AnnL -- left of "::"
-- ... -- ...
| App -- term/dimension application | App -- term/dimension application
| SApp -- substitution application | SApp -- substitution application
| Arg -- argument to nonfix function | Arg -- argument to nonfix function
%runElab derive "PPrec" [Generic, Meta, Eq, Ord, DecEq, Show]
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
export %inline export %inline
@ -100,6 +69,7 @@ hlF' = map . hl'
export %inline export %inline
parens : Doc HL -> Doc HL parens : Doc HL -> Doc HL
parens doc = hl Delim "(" <+> doc <+> hl Delim ")" parens doc = hl Delim "(" <+> doc <+> hl Delim ")"
%hide Symbols.parens
export %inline export %inline
parensIf : Bool -> Doc HL -> Doc HL parensIf : Bool -> Doc HL -> Doc HL
@ -138,7 +108,8 @@ record PrettyEnv where
||| surrounding precedence level ||| surrounding precedence level
prec : PPrec prec : PPrec
public export HasEnv : (Type -> Type) -> Type public export
HasEnv : (Type -> Type) -> Type
HasEnv = MonadReader PrettyEnv HasEnv = MonadReader PrettyEnv
export %inline export %inline

View file

@ -17,9 +17,6 @@ public export
data DimConst = Zero | One data DimConst = Zero | One
%name DimConst e %name DimConst e
private DCRepr : Type
DCRepr = Nat
%runElab derive "DimConst" [Generic, Meta, Eq, Ord, DecEq, Show] %runElab derive "DimConst" [Generic, Meta, Eq, Ord, DecEq, Show]

View file

@ -18,7 +18,6 @@ data Punc
| Arrow | DblArrow | Arrow | DblArrow
| Times | Triangle | Times | Triangle
| Wild | Wild
%runElab derive "Punc" [Generic, Meta, Eq, Ord, DecEq, Show] %runElab derive "Punc" [Generic, Meta, Eq, Ord, DecEq, Show]
@ -26,7 +25,6 @@ public export
data Keyword data Keyword
= Lam | Let | In | Case | Of | Omega = Lam | Let | In | Case | Of | Omega
| Pi | Sigma | W | Pi | Sigma | W
%runElab derive "Keyword" [Generic, Meta, Eq, Ord, DecEq, Show] %runElab derive "Keyword" [Generic, Meta, Eq, Ord, DecEq, Show]
@ -34,7 +32,6 @@ data Keyword
||| quantity & dimension constants ||| quantity & dimension constants
public export public export
data Number = Zero | One | Other Nat data Number = Zero | One | Other Nat
%runElab derive "Number" [Generic, Meta, Eq, Ord, DecEq, Show] %runElab derive "Number" [Generic, Meta, Eq, Ord, DecEq, Show]
@ -44,7 +41,6 @@ data Token
| K Keyword | K Keyword
| Name String | Symbol String | Name String | Symbol String
| N Number | TYPE Nat | N Number | TYPE Nat
%runElab derive "Token" [Generic, Meta, Eq, Ord, DecEq, Show] %runElab derive "Token" [Generic, Meta, Eq, Ord, DecEq, Show]