... | ... | @@ -17,61 +17,184 @@ Besides the indirection and the resulting complications of the ping-pong style, |
|
|
## Solutions
|
|
|
|
|
|
|
|
|
The key solution is to move source locations to the extension points, remove the indirection (e.g., the wrapper datatype `LExp`) altogether, and update the related code (e.g., functions over `Exp`) accordingly.
|
|
|
The key solution is to move source locations to the extension points, remove the indirection (e.g., the wrapper datatype `LExp`) altogether, and update the related code (e.g., functions over `Exp`) accordingly. There are a couple of ways to implement such a solution:
|
|
|
|
|
|
|
|
|
We assume that open extension typefamily instances for GHC-specific decorations are nested, such that they call a closed typefamily to choose the extension based on the index (e.g., see `XApp` calling `XAppGHC` in the code below).
|
|
|
|
|
|
There are a couple of ways to implement such a solution:
|
|
|
|
|
|
1. We put the source locations in the new constructor extension, similar in spirit to the current `Located`.
|
|
|
1. We put the source locations in the new field extensions and use a typeclass to set/get the locations.
|
|
|
|
|
|
|
|
|
In the implementation, we have settled on the solution A, as it avoids the clutter.
|
|
|
In the implementation, we have settled on the solution A, mainly as it avoids the clutter: handling of source locations is done once per data type rather than once in every constructor.
|
|
|
A list of the pros and cons, a sample code demonstrating the problem and the two solutions follows.
|
|
|
|
|
|
|
|
|
Notes:
|
|
|
There are also two related design choices (rather orthogonal design to the problem of where to store the locations):
|
|
|
|
|
|
- The API Annotations are similar to the `SrcSpan`, in that they are additional decorations, and also currently appear wherever there is a `SrcSpan`.
|
|
|
The API Annotations can be accommodated via a straightforward extension of the type class approach, by defining
|
|
|
- The old wrapper `Located a` with the constructor `L :: SrcSpan -> a -> Located a` can no longer be used to wrap syntactic entities (expressions, patterns, etc) with locations, what should be done instead?
|
|
|
For example, before, in the ping-pong style, for some expression `e :: HsExpr p` and `span1, span2 :: SrcSpan` we had
|
|
|
|
|
|
```
|
|
|
dataExtra=ExtraSrcSpan[(SrcSpan,AnnKeywordId)]classHasExtra a where
|
|
|
getSpan :: a ->SrcSpan
|
|
|
setSpan :: a ->SrcSpan-> a
|
|
|
L span1 (HsPar noExt (L span2 e))::Located(HsExpr p)
|
|
|
```
|
|
|
|
|
|
or at the same time, for some `p :: Pat p` and `span1 , span2 :: SrcSpan` we had
|
|
|
|
|
|
getApiAnns :: a ->[(SrcSpan,AnnKeywordId)]
|
|
|
setApiAnns :: a ->[(SrcSpan,AnnKeywordId)]-> a
|
|
|
```
|
|
|
L span1 (ParPat noExt (L span2 p))::Located(Pat p)
|
|
|
```
|
|
|
|
|
|
- We also currently have sections of AST without source locations, such as those generated when converting TH AST to hsSyn AST, or for GHC derived code.
|
|
|
and we could have a function like
|
|
|
|
|
|
```
|
|
|
sL1::Located a -> b ->Located b
|
|
|
sL1(L sp _)=L sp
|
|
|
```
|
|
|
|
|
|
Notice how `L` in the ping-pong style above is used to generically wrap both expressions and patterns with source locations.
|
|
|
Such a generic use of `L` in the ping-pong style is possible as we hard-coded `Located` into the definition of the trees, that we specifically want to avoid such hardcodings in the trees.
|
|
|
For example, before, in the ping-pong style, we had
|
|
|
|
|
|
```
|
|
|
dataHsExpr p =...|HsPar(XPar p)(Located(HsExpr p))|...
|
|
|
```
|
|
|
|
|
|
and
|
|
|
|
|
|
```
|
|
|
dataPat p =...|ParPat(XParPat p)(Located(Pat p))|...
|
|
|
```
|
|
|
|
|
|
In the TTG style (both solutions A and B), we won't have such a generic data constructor `L`, as`Located` won't be baked into the definition of trees.
|
|
|
For example, we will have
|
|
|
|
|
|
```
|
|
|
dataHsExpr p =...|HsPar(XPar p)(HsExpr p)|...
|
|
|
```
|
|
|
|
|
|
and
|
|
|
|
|
|
```
|
|
|
dataPat p =...|ParPat(XParPat p)(Pat p)|...
|
|
|
```
|
|
|
|
|
|
and to retain the genericity offered by baking-in `Located` (e.g., to be able to write generic functions like `sL1`, that are many), we need to resort to overloading either by directly
|
|
|
using methods of a setter/getter typeclass, that we refer to as `HasSrcSpan`, or a pattern synonym to simulate `L` using the setter/getter methods.
|
|
|
For example, we will have a typeclass
|
|
|
|
|
|
```
|
|
|
typefamilySrcSpanLess a
|
|
|
classHasSrcSpan a where
|
|
|
composeSrcSpan ::(SrcSpanLess a ,SrcSpan)-> a
|
|
|
decomposeSrcSpan :: a ->(SrcSpanLess a ,SrcSpan){- laws:
|
|
|
composeSrcSpan . decomposeSrcSpan = id
|
|
|
decomposeSrcSpan . composeSrcSpan = id
|
|
|
-}
|
|
|
```
|
|
|
|
|
|
(or,
|
|
|
|
|
|
```
|
|
|
typefamilySrcSpaned a
|
|
|
classHasSrcSpan a where
|
|
|
composeSrcSpan ::(a ,SrcSpan)->SrcSpaned a
|
|
|
decomposeSrcSpan ::SrcSpaned a ->(a ,SrcSpan){- laws:
|
|
|
composeSrcSpan . decomposeSrcSpan = id
|
|
|
decomposeSrcSpan . composeSrcSpan = id
|
|
|
-}
|
|
|
```
|
|
|
|
|
|
)
|
|
|
and possibly a pattern synonym
|
|
|
|
|
|
```
|
|
|
patternLL::HasSrcSpan a =>SrcSpan->SrcSpanLess a -> a
|
|
|
patternLL s m <-(decomposeSrcSpan ->(m , s))whereLL s m = composeSrcSpan (m , s)
|
|
|
```
|
|
|
|
|
|
>
|
|
|
> We can perhaps deal with these by either defining an additional pass, so
|
|
|
> so by providing instances for `HasSrcSpan` (by either Solution A or Solution B),
|
|
|
|
|
|
>
|
|
|
> for some expression `e :: HsExpr (GhcPass p)` and `span1, span2 :: SrcSpan`, we will have
|
|
|
|
|
|
```
|
|
|
dataPass=Parsed|Renamed|Typechecked|Generatedderiving(Data)
|
|
|
LL span1 (HsPar noExt (LL span2 e))::HsExpr(GhcPass p)
|
|
|
```
|
|
|
|
|
|
>
|
|
|
> or by making the extra information status dependent on an additional parameter, so
|
|
|
> or at the same time, for some `p :: Pat (GhcPass p)` and `span1 , span2 :: SrcSpan` we had
|
|
|
|
|
|
```
|
|
|
dataGhcPass(l ::Location)(c ::Pass)derivinginstanceEq(GhcPass c)derivinginstance(Typeable l,Typeable c)=>Data(GhcPass l c)dataPass=Parsed|Renamed|Typecheckedderiving(Data)dataLocation=Located|UnLocated
|
|
|
LL span1 (ParPat noExt (LL span2 p))::Pat(GhcPass p)
|
|
|
```
|
|
|
|
|
|
>
|
|
|
> Thanks to Zubin Duggal for bringing the unlocated problem up on IRC.
|
|
|
> and we could have a function like
|
|
|
|
|
|
- The setter/getter functions can be generalised to set/get anything:
|
|
|
```
|
|
|
sL1::(HasSrcSpan a ,HasSrcSpan b)=> a ->SrcSpanLess b -> b
|
|
|
sL1(LL sp _)=LL sp
|
|
|
```
|
|
|
|
|
|
- We may, or may not, assume that open extension typefamily instances for GHC-specific decorations are nested, such that they call a closed typefamily to choose the extension based on the index.
|
|
|
|
|
|
>
|
|
|
> For example, instead of a list of open type family instances
|
|
|
|
|
|
```
|
|
|
classHas b a where
|
|
|
get :: a -> b
|
|
|
set :: a -> b -> a
|
|
|
typeinstanceXApp(GHCPs)=()typeinstanceXApp(GHCRn)=()typeinstanceXApp(GHCTc)=Type
|
|
|
```
|
|
|
|
|
|
>
|
|
|
> we can have
|
|
|
|
|
|
```
|
|
|
typeinstanceXApp(GHC p)=XAppGHC p
|
|
|
typefamilyXAppGHC(p ::Phase)whereXAppGHCPs=()XAppGHCRn=()XAppGHCTc=Type
|
|
|
```
|
|
|
|
|
|
>
|
|
|
> The closed type family solution is elegant and solves some of the constraint solving problems in place (see the commented section in type class instance of solution B). However, the closed typed family solution couples together the code from different stages of the compiler, e.g., the definition of a parser with the type `parseExp :: String -> M (HsExpr (Ghc Ps))` (for some parsing monad `M`) refers to the closed type family `XAppGHC` which refers to the definition `Type` that is not relevant to the parsing phase. We want the parser and other machineries within GHC front-end (e.g., the pretty-printer) to not to be GHC-specific (e.g., depending on `Type`, or even core via `Tickish`!).
|
|
|
|
|
|
## Pros & Cons
|
|
|
|
|
|
### Solution A: the source locations in the new constructor extension
|
|
|
|
|
|
|
|
|
Pros:
|
|
|
|
|
|
- It makes it easy to omit locations altogether (see the notes about "Generated" code).
|
|
|
This is a Good Thing.
|
|
|
- It makes it easy to store fewer locations (e.g. one location for `(f x y z)`,
|
|
|
rather than one for `(f x y z)`, one for `(f x y)`, and one for `(f x)`).
|
|
|
- It's easy to add the current location to the monad
|
|
|
|
|
|
> `f (XNew loc e) = setLoc loc $ f e`
|
|
|
|
|
|
>
|
|
|
> Simple, elegant!
|
|
|
|
|
|
|
|
|
Cons:
|
|
|
|
|
|
- At the binding site of a variable we know that we \*always\* have a location, and we can put that in its Name.
|
|
|
If locations were more optional, that would not be so true.
|
|
|
|
|
|
### Solution B: the source locations in the new field extensions
|
|
|
|
|
|
|
|
|
Pros:
|
|
|
|
|
|
- TODO
|
|
|
|
|
|
|
|
|
Cons:
|
|
|
|
|
|
- An instance of `HasSpan` should be defined per datatype which requires a large pattern matching over datatype
|
|
|
- Handling of the source locations should be done once per constructor
|
|
|
- When constructing/generating terms the first field of the constructors should explicitly mention the source location
|
|
|
(see the `par` function in the Solution A's code, where the first field of `Par` should have a `SrcSpan`, even though a dummy one.)
|
|
|
|
|
|
## An example to illustrate
|
|
|
|
|
|
|
... | ... | @@ -92,14 +215,15 @@ typefamilyXId x |
|
|
with some basic GHC-specific types defined as
|
|
|
|
|
|
```
|
|
|
{-# OPTIONS_GHC -Wall -fno-warn-unticked-promoted-constructors #-}{-# LANGUAGE TypeFamilies , DataKinds #-}moduleBasicGHCTypeswhereimportData.Void-- ------------------------------------------------ GHC-Specific Declarations-- ----------------------------------------------dataPhase=Ps|Rn|TcdataGHC(p ::Phase)dataRdrName-- = the definition of RdrNamedataName-- = the definition of NamedataId-- = the definition of IddataSrcSpan-- = the definition of SrcSpandataType-- = the definition of SrcSpandataUnboundVar-- = the definition of UnboundVardataLocated a =LSrcSpan a
|
|
|
{-# OPTIONS_GHC -Wall -fno-warn-unticked-promoted-constructors #-}{-# LANGUAGE TypeFamilies , DataKinds, EmptyDataDeriving, EmptyCase #-}moduleBasicGHCTypeswhere-- ------------------------------------------------ GHC-Specific Declarations-- ----------------------------------------------dataPhase=Ps|Rn|TcdataGHC(p ::Phase)dataNoExt=NoExtdataNoNewConnoNewCon::NoNewCon-> a
|
|
|
noNewCon x =case x of{}dataRdrName-- = the definition of RdrNamedataName-- = the definition of NamedataId-- = the definition of IddataType-- = the definition of SrcSpandataUnboundVar-- = the definition of UnboundVardataSrcSpan-- = the definition of SrcSpanderivingEqdataLocated a =LSrcSpan a
|
|
|
|
|
|
getLoc::Located a ->SrcSpangetLoc(L sp _)= sp
|
|
|
|
|
|
setLoc::Located a ->SrcSpan->Located a
|
|
|
setLoc(L_ x) sp' =L sp' x
|
|
|
|
|
|
noLoc::SrcSpannoLoc= undefined -- or be an empty SrcSpantypefamilyXAppGHC(p ::Phase)whereXAppGHCPs=()XAppGHCRn=()XAppGHCTc=TypetypefamilyXNewGHC(p ::Phase)whereXNewGHCPs=VoidXNewGHC_=UnboundVartypefamilyXIdGHC(p ::Phase)whereXIdGHCPs=RdrNameXIdGHCRn=NameXIdGHCTc=Id
|
|
|
noSrcSpan::SrcSpannoSrcSpan= undefined -- or be an empty SrcSpantypefamilyXAppGHC(p ::Phase)typeinstanceXAppGHCPs=NoExttypeinstanceXAppGHCRn=NoExttypeinstanceXAppGHCTc=TypetypefamilyXNewGHC(p ::Phase)typeinstanceXNewGHCPs=NoNewContypeinstanceXNewGHCRn=UnboundVartypeinstanceXNewGHCTc=UnboundVartypefamilyXIdGHC(p ::Phase)typeinstanceXIdGHCPs=RdrNametypeinstanceXIdGHCRn=NametypeinstanceXIdGHCTc=Id-- NB: if GHC later wants to add extension fields to (say)-- XAbs, we can just redefine XAbs (GHC p) to be more like-- the XApp case
|
|
|
```
|
|
|
|
|
|
|
... | ... | @@ -116,18 +240,50 @@ Unfortunately, this forces us to redefine the base TTG data type, |
|
|
forcing it into ping-pong style, which is why we don't like it for the reasons mentioned above.
|
|
|
|
|
|
```
|
|
|
{-# OPTIONS_GHC -Wall #-}{-# LANGUAGE TypeFamilies #-}moduleOriginalwhereimportBasicGHCTypes-- ------------------------------------------------ AST Base-- ----------------------------------------------typeLExp x =Located(Exp x)dataExp x -- Notice the alternation between LExp and Exp=Var(XVar x)(XId x)|Abs(XAbs x)(XId x)(LExp x)|App(XApp x)(LExp x)(LExp x)|Par(XPar x)(LExp x)|New(XNew x)-- The extension constructortypefamilyXVar x
|
|
|
{-# OPTIONS_GHC -Wall -fno-warn-unticked-promoted-constructors #-}{-# LANGUAGE TypeFamilies, DataKinds #-}moduleOriginalwhereimportBasicGHCTypes-- ------------------------------------------------ AST Base-- ----------------------------------------------typeLExp x =Located(Exp x)dataExp x -- Notice the alternation between LExp and Exp=Var(XVar x)(XId x)|Abs(XAbs x)(XId x)(LExp x)|App(XApp x)(LExp x)(LExp x)|Par(XPar x)(LExp x)|New(XNew x)-- The extension constructortypefamilyXVar x
|
|
|
typefamilyXAbs x
|
|
|
typefamilyXApp x
|
|
|
typefamilyXPar x
|
|
|
typefamilyXNew x
|
|
|
typefamilyXId x
|
|
|
|
|
|
-- ------------------------------------------------ GHC-Specific Decorations-- ----------------------------------------------typeinstanceXVar(GHC_)=()typeinstanceXAbs(GHC_)=()typeinstanceXApp(GHC p)=XAppGHC p
|
|
|
typeinstanceXPar(GHC_)=()typeinstanceXNew(GHC p)=XNewGHC p
|
|
|
-- ------------------------------------------------ GHC-Specific Decorations-- ----------------------------------------------typeinstanceXVar(GHC_)=NoExttypeinstanceXAbs(GHC_)=NoExttypeinstanceXApp(GHC p)=XAppGHC p
|
|
|
typeinstanceXPar(GHC_)=NoExttypeinstanceXNew(GHC p)=XNewGHC p
|
|
|
typeinstanceXId(GHC p)=XIdGHC p
|
|
|
|
|
|
-- ------------------------------------------------ Example Function-- ----------------------------------------------par::LExp(GHC x)->LExp(GHC x)par l@(L sp (App{}))=L sp (Par() l)par l = l
|
|
|
-- ------------------------------------------------ Example Function-- ----------------------------------------------par::LExp(GHC x)->LExp(GHC x)par l@(L sp (App{}))=L sp (ParNoExt l)par l = l
|
|
|
```
|
|
|
|
|
|
### The SrcSpan Accessor Typeclass
|
|
|
|
|
|
|
|
|
Here is a complete definition of the `HasSrcSpan` typeclass mentioned earlier:
|
|
|
|
|
|
```
|
|
|
{-# OPTIONS_GHC -Wall #-}{-# LANGUAGE TypeFamilies, PatternSynonyms, ViewPatterns #-}moduleHasSrcSpanwhereimportBasicGHCTypestypefamilySrcSpanLess a
|
|
|
classHasSrcSpan a where
|
|
|
composeSrcSpan ::(SrcSpanLess a ,SrcSpan)-> a
|
|
|
decomposeSrcSpan :: a ->(SrcSpanLess a ,SrcSpan){- laws:
|
|
|
composeSrcSpan . decomposeSrcSpan = id
|
|
|
decomposeSrcSpan . composeSrcSpan = id
|
|
|
-}unSrcSpan::HasSrcSpan a => a ->SrcSpanLess a
|
|
|
unSrcSpan= fst . decomposeSrcSpan
|
|
|
|
|
|
getSrcSpan::HasSrcSpan a => a ->SrcSpangetSrcSpan= snd . decomposeSrcSpan
|
|
|
|
|
|
setSrcSpan::HasSrcSpan a => a ->SrcSpan-> a
|
|
|
setSrcSpan e sp = composeSrcSpan (unSrcSpan e , sp)typeinstanceSrcSpanLess(Located a)= a
|
|
|
instanceHasSrcSpan(Located a)where
|
|
|
composeSrcSpan (e , sp)=L sp e
|
|
|
decomposeSrcSpan (L sp e)=(e , sp)typeinstanceSrcSpanLessSrcSpan=SrcSpaninstanceHasSrcSpanSrcSpanwhere
|
|
|
composeSrcSpan (_, sp)= sp
|
|
|
decomposeSrcSpan sp =(sp , sp)typeinstanceSrcSpanLessNoNewCon=NoNewConinstanceHasSrcSpanNoNewConwhere
|
|
|
composeSrcSpan (n ,_)= noNewCon n
|
|
|
decomposeSrcSpan n = noNewCon n
|
|
|
|
|
|
|
|
|
patternLL::HasSrcSpan a =>SrcSpan->SrcSpanLess a -> a
|
|
|
patternLL s m <-(decomposeSrcSpan ->(m , s))whereLL s m = composeSrcSpan (m , s)
|
|
|
```
|
|
|
|
|
|
### Solution A - Example Code
|
... | ... | @@ -140,10 +296,16 @@ In the code below, as compared to the ping-pong style above, we have the followi |
|
|
- a pattern synonym `LL` is introduced using the new constructor
|
|
|
|
|
|
```
|
|
|
{-# OPTIONS_GHC -Wall #-}{-# LANGUAGE TypeFamilies, PatternSynonyms #-}moduleSolutionBwhereimportBasicGHCTypesimportTTG-- ------------------------------------------------ GHC-Specific Decorations-- ----------------------------------------------typeinstanceXVar(GHC_)=()typeinstanceXAbs(GHC_)=()typeinstanceXApp(GHC p)=XAppGHC p
|
|
|
typeinstanceXPar(GHC_)=()typeinstanceXNew(GHC p)=Either(Located(Exp(GHC p)))(XNewGHC p)typeinstanceXId(GHC p)=XIdGHC p
|
|
|
|
|
|
-- NB: if GHC later wants to add extension fields to (say)-- XAbs, we can just redefine XAbs (GHC p) to be more like-- the XApp case-- ------------------------------------------------ LL Pattern Synonym-- ----------------------------------------------patternLL::SrcSpan->Exp(GHC p)->Exp(GHC p)patternLL sp m =New(Left(L sp m))-- ------------------------------------------------ Example Function-- ----------------------------------------------par::Exp(GHC p)->Exp(GHC p)par l@(LL sp (App{}))=LL sp (Par() l)par l = l
|
|
|
{-# OPTIONS_GHC -Wall -fno-warn-unticked-promoted-constructors
|
|
|
-fno-warn-orphans #-}{-# LANGUAGE TypeFamilies, PatternSynonyms, DataKinds, FlexibleInstances #-}moduleSolutionAwhereimportBasicGHCTypesimportTTGimportHasSrcSpan-- ------------------------------------------------ GHC-Specific Decorations-- ----------------------------------------------typeinstanceXVar(GHC_)=NoExttypeinstanceXAbs(GHC_)=NoExttypeinstanceXApp(GHC p)=XAppGHC p
|
|
|
typeinstanceXPar(GHC_)=NoExttypeinstanceXNew(GHC p)=Either(Located(Exp(GHC p)))(XNewGHC p)typeinstanceXId(GHC p)=XIdGHC p
|
|
|
|
|
|
-- ------------------------------------------------ HasSrcSpan Instance-- ----------------------------------------------typeinstanceSrcSpanLess(Exp(GHC p))=Exp(GHC p)instanceHasSrcSpan(Exp(GHC p))where
|
|
|
composeSrcSpan (m , sp)=if noSrcSpan == sp
|
|
|
then m
|
|
|
elseNew(Left(L sp m))
|
|
|
decomposeSrcSpan (New(Left(L sp m)))=(m , sp)
|
|
|
decomposeSrcSpan m =(m , noSrcSpan)-- ------------------------------------------------ Example Function-- ----------------------------------------------par::Exp(GHC p)->Exp(GHC p)par l@(LL sp (App{}))=LL sp (ParNoExt l)par l = l
|
|
|
```
|
|
|
|
|
|
### Solution B - Example Code
|
... | ... | @@ -158,85 +320,72 @@ In the code below, as compared to the ping-pong style above, we have the followi |
|
|
- a pattern synonym `LL` is introduced using the setter/getter function pair
|
|
|
|
|
|
```
|
|
|
{-# OPTIONS_GHC -Wall #-}{-# LANGUAGE TypeFamilies, PatternSynonyms, ViewPatterns, FlexibleInstances #-}moduleSolutionAwhereimportData.VoidimportBasicGHCTypesimportTTG-- ------------------------------------------------ GHC-Specific Decorations-- ----------------------------------------------typeinstanceXVar(GHC p)=Located()typeinstanceXAbs(GHC p)=Located()typeinstanceXApp(GHC p)=Located(XAppGHC p)typeinstanceXPar(GHC p)=Located()typeinstanceXNew(GHC p)=Located(XNewGHC p)typeinstanceXId(GHC p)=XIdGHC p
|
|
|
{-# OPTIONS_GHC -Wall -fno-warn-unticked-promoted-constructors
|
|
|
-fno-warn-orphans #-}{-# LANGUAGE TypeFamilies, PatternSynonyms, DataKinds, FlexibleInstances #-}moduleSolutionBwhereimportBasicGHCTypesimportTTGimportHasSrcSpan-- ------------------------------------------------ GHC-Specific Decorations-- ----------------------------------------------typeinstanceXVar(GHC_)=LocatedNoExttypeinstanceXAbs(GHC_)=LocatedNoExttypeinstanceXApp(GHC p)=Located(XAppGHC p)typeinstanceXPar(GHC_)=LocatedNoExttypeinstanceXNew(GHC p)=Located(XNewGHC p)typeinstanceXId(GHC p)=XIdGHC p
|
|
|
|
|
|
-- NB: if GHC later wants to add extension fields to (say)-- XAbs, we can just redefine XAbs (GHC p) to be more like-- the XApp case-- ------------------------------------------------ HasSpan Typeclass and LL Pattern Synonym-- ----------------------------------------------classHasSpan a where
|
|
|
getSpan :: a ->SrcSpan
|
|
|
setSpan :: a ->SrcSpan-> a
|
|
|
|
|
|
instanceHasSpanSrcSpanwhere
|
|
|
getSpan = id
|
|
|
setSpan _= id
|
|
|
|
|
|
instanceHasSpanVoidwhere
|
|
|
getSpan x = absurd x
|
|
|
setSpan x _= absurd x
|
|
|
|
|
|
instanceHasSpan(Located a)where
|
|
|
getSpan = getLoc
|
|
|
setSpan = setLoc
|
|
|
|
|
|
instanceHasSpan(Exp(GHC p))where{- or,
|
|
|
-- ------------------------------------------------ HasSrcSpan Instance-- ----------------------------------------------typeinstanceSrcSpanLess(Exp(GHC p))=Exp(GHC p)instanceHasSrcSpan(Exp(GHC p))where{- or,
|
|
|
type ForallX (p :: * -> Constraint) x
|
|
|
= ( p (XVar x) , p (XAbs x) , p (XApp x) , p (XPar x)
|
|
|
, p (XNew x) )
|
|
|
|
|
|
instance ForallX HasSpan x => HasSpan (Exp x) where
|
|
|
instance ForallX HasSrcSpan x => HasSrcSpan (Exp x) where
|
|
|
-}
|
|
|
getSpan (Var ex _)= getSpan ex
|
|
|
getSpan (Abs ex __)= getSpan ex
|
|
|
getSpan (App ex __)= getSpan ex
|
|
|
getSpan (Par ex _)= getSpan ex
|
|
|
getSpan (New ex)= getSpan ex
|
|
|
|
|
|
setSpan (Var ex x) sp =Var(setSpan ex sp) x
|
|
|
setSpan (Abs ex x n) sp =Abs(setSpan ex sp) x n
|
|
|
setSpan (App ex l m) sp =App(setSpan ex sp) l m
|
|
|
setSpan (Par ex m) sp =Par(setSpan ex sp) m
|
|
|
setSpan (New ex) sp =New(setSpan ex sp)getSpan'::HasSpan a => a ->Located a
|
|
|
getSpan' m =L(getSpan m) m
|
|
|
|
|
|
patternLL::HasSpan a =>SrcSpan-> a -> a
|
|
|
patternLL s m <-(getSpan' ->L s m)whereLL s m = setSpan m s
|
|
|
|
|
|
-- ------------------------------------------------ Example Function-- ----------------------------------------------par::Exp(GHC p)->Exp(GHC p)par l@(LL sp (App{}))=LL sp (Par(L noLoc ()) l)par l = l
|
|
|
composeSrcSpan (Var ex x , sp)=Var(setSrcSpan ex sp) x
|
|
|
composeSrcSpan (Abs ex x n , sp)=Abs(setSrcSpan ex sp) x n
|
|
|
composeSrcSpan (App ex l m , sp)=App(setSrcSpan ex sp) l m
|
|
|
composeSrcSpan (Par ex m , sp)=Par(setSrcSpan ex sp) m
|
|
|
composeSrcSpan (New ex , sp)=New(setSrcSpan ex sp)
|
|
|
|
|
|
decomposeSrcSpan m@(Var ex _)=(m , getSrcSpan ex)
|
|
|
decomposeSrcSpan m@(Abs ex __)=(m , getSrcSpan ex)
|
|
|
decomposeSrcSpan m@(App ex __)=(m , getSrcSpan ex)
|
|
|
decomposeSrcSpan m@(Par ex _)=(m , getSrcSpan ex)
|
|
|
decomposeSrcSpan m@(New ex)=(m , getSrcSpan ex)-- ------------------------------------------------ Example Function-- ----------------------------------------------par::Exp(GHC p)->Exp(GHC p)par l@(LL sp (App{}))=Par(L sp NoExt) l
|
|
|
{- or,
|
|
|
= LL sp (Par (L noSrcSpan NoExt) l)
|
|
|
-}par l = l
|
|
|
```
|
|
|
|
|
|
## Pros & Cons
|
|
|
## Extra Notes
|
|
|
|
|
|
### Solution A
|
|
|
|
|
|
Here are some extra notes:
|
|
|
|
|
|
Pros:
|
|
|
|
|
|
- It makes it easy to omit locations altogether (see the notes about "Generated" code).
|
|
|
This is a Good Thing.
|
|
|
- It makes it easy to store fewer locations (e.g. one location for `(f x y z)`,
|
|
|
rather than one for `(f x y z)`, one for `(f x y)`, and one for `(f x)`).
|
|
|
- It's easy to add the current location to the monad
|
|
|
|
|
|
> `f (XNew loc e) = setLoc loc $ f e`
|
|
|
|
|
|
>
|
|
|
> Simple, elegant!
|
|
|
- The API Annotations are similar to the `SrcSpan`, in that they are additional decorations, and also currently appear wherever there is a `SrcSpan`.
|
|
|
The API Annotations can be accommodated via a straightforward extension of the type class approach, by defining
|
|
|
|
|
|
```
|
|
|
dataExtra=ExtraSrcSpan[(SrcSpan,AnnKeywordId)]classHasExtra a where
|
|
|
getSpan :: a ->SrcSpan
|
|
|
setSpan :: a ->SrcSpan-> a
|
|
|
|
|
|
Cons:
|
|
|
getApiAnns :: a ->[(SrcSpan,AnnKeywordId)]
|
|
|
setApiAnns :: a ->[(SrcSpan,AnnKeywordId)]-> a
|
|
|
```
|
|
|
|
|
|
- At the binding site of a variable we know that we \*always\* have a location, and we can put that in its Name.
|
|
|
If locations were more optional, that would not be so true.
|
|
|
- We also currently have sections of AST without source locations, such as those generated when converting TH AST to hsSyn AST, or for GHC derived code.
|
|
|
|
|
|
### Solution B
|
|
|
>
|
|
|
> We can perhaps deal with these by either defining an additional pass, so
|
|
|
|
|
|
```
|
|
|
dataPass=Parsed|Renamed|Typechecked|Generatedderiving(Data)
|
|
|
```
|
|
|
|
|
|
Pros:
|
|
|
>
|
|
|
> or by making the extra information status dependent on an additional parameter, so
|
|
|
|
|
|
- TODO
|
|
|
```
|
|
|
dataGhcPass(l ::Location)(c ::Pass)derivinginstanceEq(GhcPass c)derivinginstance(Typeable l,Typeable c)=>Data(GhcPass l c)dataPass=Parsed|Renamed|Typecheckedderiving(Data)dataLocation=Located|UnLocated
|
|
|
```
|
|
|
|
|
|
>
|
|
|
> Thanks to Zubin Duggal for bringing the unlocated problem up on IRC.
|
|
|
|
|
|
Cons:
|
|
|
- The setter/getter functions can be generalised to set/get anything:
|
|
|
|
|
|
- An instance of `HasSpan` should be defined per datatype
|
|
|
- Handling of the source locations should be done once per constructor
|
|
|
- When constructing/generating terms the first field of the constructors should explicitly mention the source location
|
|
|
(see the `par` function in the Solution A's code, where the first field of `Par` should have a `SrcSpan`, even though a dummy one.) |
|
|
```
|
|
|
classHas b a where
|
|
|
get :: a -> b
|
|
|
set :: a -> b -> a
|
|
|
``` |
|
|
\ No newline at end of file |