quox/lib/Quox/Parser/Syntax.idr

237 lines
5.3 KiB
Idris
Raw Normal View History

module Quox.Parser.Syntax
import public Quox.Loc
import public Quox.Syntax
2023-03-06 05:35:57 -05:00
import public Quox.Definition
2023-10-19 22:53:20 -04:00
import Quox.PrettyValExtra
import Derive.Prelude
%hide TT.Name
%default total
%language ElabReflection
public export
data PatVar = Unused Loc | PV PBaseName Loc
%name PatVar v
2023-10-19 22:53:20 -04:00
%runElab derive "PatVar" [Eq, Ord, Show, PrettyVal]
export
Located PatVar where
(Unused loc).loc = loc
(PV _ loc).loc = loc
export
(.name) : PatVar -> Maybe PBaseName
(Unused _).name = Nothing
(PV nm _).name = Just nm
export
isUnused : PatVar -> Bool
isUnused (Unused {}) = True
isUnused _ = False
public export
2023-05-01 21:06:25 -04:00
record PQty where
constructor PQ
val : Qty
loc_ : Loc
%name PQty qty
2023-10-19 22:53:20 -04:00
%runElab derive "PQty" [Eq, Ord, Show, PrettyVal]
2023-05-01 21:06:25 -04:00
export Located PQty where q.loc = q.loc_
namespace PDim
public export
data PDim = K DimConst Loc | V PBaseName Loc
2023-03-05 10:49:50 -05:00
%name PDim p, q
2023-10-19 22:53:20 -04:00
%runElab derive "PDim" [Eq, Ord, Show, PrettyVal]
export
Located PDim where
(K _ loc).loc = loc
(V _ loc).loc = loc
public export
data PTagVal = PT TagVal Loc
%name PTagVal tag
2023-10-19 22:53:20 -04:00
%runElab derive "PTagVal" [Eq, Ord, Show, PrettyVal]
namespace PTerm
mutual
||| terms out of the parser with BVs and bidirectionality still tangled up
public export
data PTerm =
TYPE Universe Loc
| IOState Loc
| Pi PQty PatVar PTerm PTerm Loc
| Lam PatVar PTerm Loc
| App PTerm PTerm Loc
| Sig PatVar PTerm PTerm Loc
| Pair PTerm PTerm Loc
| Case PQty PTerm (PatVar, PTerm) PCaseBody Loc
2023-09-18 15:52:51 -04:00
| Fst PTerm Loc | Snd PTerm Loc
| Enum (List TagVal) Loc
| Tag TagVal Loc
| Eq (PatVar, PTerm) PTerm PTerm Loc
| DLam PatVar PTerm Loc
| DApp PTerm PDim Loc
2023-11-02 13:14:22 -04:00
| NAT Loc
| Nat Nat Loc | Succ PTerm Loc
2023-03-26 08:40:54 -04:00
| STRING Loc -- "String" is a reserved word in idris
| Str String Loc
| BOX PQty PTerm Loc
| Box PTerm Loc
2023-03-31 13:11:35 -04:00
2023-05-21 14:09:34 -04:00
| V PName (Maybe Universe) Loc
| Ann PTerm PTerm Loc
2023-04-15 09:13:01 -04:00
| Coe (PatVar, PTerm) PDim PDim PTerm Loc
| Comp (PatVar, PTerm) PDim PDim PTerm PDim
(PatVar, PTerm) (PatVar, PTerm) Loc
2023-12-04 12:48:25 -05:00
| Let (PQty, PatVar, PTerm) PTerm Loc
2023-03-05 10:49:50 -05:00
%name PTerm s, t
public export
data PCaseBody =
CasePair (PatVar, PatVar) PTerm Loc
| CaseEnum (List (PTagVal, PTerm)) Loc
| CaseNat PTerm (PatVar, PQty, PatVar, PTerm) Loc
| CaseBox PatVar PTerm Loc
2023-03-05 10:49:50 -05:00
%name PCaseBody body
public export %inline
Zero : Loc -> PTerm
Zero = Nat 0
2023-10-19 22:53:20 -04:00
%runElab deriveMutual ["PTerm", "PCaseBody"] [Eq, Ord, Show, PrettyVal]
export
Located PTerm where
(TYPE _ loc).loc = loc
(IOState loc).loc = loc
(Pi _ _ _ _ loc).loc = loc
(Lam _ _ loc).loc = loc
(App _ _ loc).loc = loc
(Sig _ _ _ loc).loc = loc
(Pair _ _ loc).loc = loc
(Fst _ loc).loc = loc
(Snd _ loc).loc = loc
(Case _ _ _ _ loc).loc = loc
(Enum _ loc).loc = loc
(Tag _ loc).loc = loc
(Eq _ _ _ loc).loc = loc
(DLam _ _ loc).loc = loc
(DApp _ _ loc).loc = loc
2023-11-02 13:14:22 -04:00
(NAT loc).loc = loc
(Nat _ loc).loc = loc
(Succ _ loc).loc = loc
(STRING loc).loc = loc
(Str _ loc).loc = loc
(BOX _ _ loc).loc = loc
(Box _ loc).loc = loc
(V _ _ loc).loc = loc
(Ann _ _ loc).loc = loc
(Coe _ _ _ _ loc).loc = loc
(Comp _ _ _ _ _ _ _ loc).loc = loc
2023-12-04 12:48:25 -05:00
(Let _ _ loc).loc = loc
export
Located PCaseBody where
(CasePair _ _ loc).loc = loc
(CaseEnum _ loc).loc = loc
(CaseNat _ _ loc).loc = loc
(CaseBox _ _ loc).loc = loc
public export
data PBody = PConcrete (Maybe PTerm) PTerm | PPostulate PTerm
%name PBody body
%runElab derive "PBody" [Eq, Ord, Show, PrettyVal]
2023-11-05 14:49:02 -05:00
public export
data PFail =
PSucceed
| PFailAny
| PFailMatch String
%runElab derive "PFail" [Eq, Ord, Show, PrettyVal]
2023-03-06 05:35:57 -05:00
public export
record PDefinition where
constructor MkPDef
2023-11-05 14:49:02 -05:00
qty : PQty
name : PBaseName
body : PBody
fail : PFail
main : Bool
scheme : Maybe String
loc_ : Loc
2023-03-06 05:35:57 -05:00
%name PDefinition def
2023-10-19 22:53:20 -04:00
%runElab derive "PDefinition" [Eq, Ord, Show, PrettyVal]
2023-03-06 05:35:57 -05:00
export Located PDefinition where def.loc = def.loc_
mutual
public export
record PNamespace where
constructor MkPNamespace
name : Mods
decls : List PDecl
2023-11-05 14:49:02 -05:00
fail : PFail
loc_ : Loc
%name PNamespace ns
public export
2023-11-05 14:49:02 -05:00
data PDecl =
PDef PDefinition
| PNs PNamespace
%name PDecl decl
%runElab deriveMutual ["PNamespace", "PDecl"] [Eq, Ord, Show, PrettyVal]
export Located PNamespace where ns.loc = ns.loc_
export
2023-11-05 14:49:02 -05:00
Located PDecl where
(PDef d).loc = d.loc
(PNs ns).loc = ns.loc
public export
data PTopLevel = PD PDecl | PLoad String Loc
%name PTopLevel t
2023-10-19 22:53:20 -04:00
%runElab derive "PTopLevel" [Eq, Ord, Show, PrettyVal]
export
Located PTopLevel where
(PD decl).loc = decl.loc
(PLoad _ loc).loc = loc
2023-11-05 14:49:02 -05:00
public export
record PAttr where
constructor PA
name : PBaseName
args : List PTerm
loc_ : Loc
%name PAttr attr
%runElab derive "PAttr" [Eq, Ord, Show, PrettyVal]
export Located PAttr where attr.loc = attr.loc_
2023-10-19 23:23:56 -04:00
public export
PFile : Type
PFile = List PTopLevel