Edit ImplementingTreesThatGrow/HandlingSourceLocations authored by Shayan-Najd's avatar Shayan-Najd
......@@ -3,12 +3,12 @@
## Problem
The current design of TTG [HsSyn](implementing-trees-that-grow/hs-syn) AST in GHC stores source locations for terms of a datatype `Exp` in a separate wrapper datatype `LExp` which is mutually recursive with `Exp` such that every recursive reference to `Exp` is done **indirectly**, via a reference to the wrapper datatype `LExp`. We refer to this style of storing source locations as the ping-pong style.
The current design of [ TTG HsSyn AST](https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow/TreesThatGrowGuidance) in GHC stores source locations for terms of a datatype `Exp` in a separate wrapper datatype `LExp` which is mutually recursive with `Exp` such that every recursive reference to `Exp` is done **indirectly**, via a reference to the wrapper datatype `LExp` (see the example code below). We refer to this style of storing source locations as the ping-pong style.
Besides the indirection and the complications the ping-pong style causes, there are two key problems with it:
Besides the indirection and the resulting complications of the ping-pong style, there are two key problems with it:
1. It bakes-in the source locations in the base AST, forcing all instances to store source locations, even if they don't need them.
1. It bakes-in the source locations in the base TTG AST, forcing all instances to store source locations, even if they don't need them.
For example, TH AST does not carry source locations.
1. It results in a form of conceptual redundancy: source locations are tree decorations and they belong in the extension points.
......@@ -39,7 +39,7 @@ data SrcSpan
data Located a = L SrcSpan a
-- ----------------------------------------------
-- AST Base
-- TTG Base AST
-- ----------------------------------------------
type LExp x = Located (Exp x)
......@@ -84,7 +84,7 @@ type instance XNew Ps = Void
type instance XId Ps = RdrName
-- ----------------------------------------------
-- Example Function
-- Example Function (e.g., in pretty printing)
-- ----------------------------------------------
par :: LExp Ps -> LExp Ps
......@@ -97,11 +97,23 @@ par l@(L sp m) = L sp (Par () l)
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:
1. TODO Using a typeclass
1. TODO Nesting extension typefamilies
1. TODO inlining the typeclass methods of (a) by hand
1. Using a typeclass to set/get source locations
### Example
1. We can nest extension typefamilies to be able to say that all constructors have the same uniform decorations (e.g., `SrcSpan`) beside their specific ones. This is just for convenience as `ForallX*` constraint quantifications can simulate the same (see the code for solution A).
1. We can extend (using TTG) each datatype to add a wrapper constructor like the current `Located`.
1. TODO (add your suggestions)
### Example (Solution A)
In the code below, as compared to the one above, we have the following key changes:
- `LExp` is replaced with `Exp`
- field extensions are set to have a `SrcSpan` (instead of `()`)
- a setter/getter typeclass `HasSpan` (and instances) is introduced
- a pattern synonym for `L` is introduced using the typeclass
```wiki
{-# LANGUAGE TypeFamilies
......@@ -126,18 +138,18 @@ data SrcSpan
-- = the definition of SrcSpan
-- ----------------------------------------------
-- AST Base
-- TTG Base AST
-- ----------------------------------------------
data Exp x
= Var (XVar x) (XId x)
| Abs (XAbs x) (XId x) (Exp x)
| Lam (XLam x) (XId x) (Exp x)
| App (XApp x) (Exp x) (Exp x)
| Par (XPar x) (Exp x)
| New (XNew x)
type family XVar x
type family XAbs x
type family XLam x
type family XApp x
type family XPar x
type family XNew x
......@@ -146,7 +158,7 @@ type family XId x
type ForallX (p :: * -> Constraint) x
= ( p (XVar x)
, p (XAbs x)
, p (XLam x)
, p (XApp x)
, p (XPar x)
, p (XNew x)
......@@ -161,7 +173,7 @@ data Ps
type ExpPs = Exp Ps
type instance XVar Ps = SrcSpan
type instance XAbs Ps = SrcSpan
type instance XLam Ps = SrcSpan
type instance XApp Ps = SrcSpan
type instance XPar Ps = SrcSpan
type instance XNew Ps = Void
......@@ -186,12 +198,12 @@ instance HasSpan Void where
instance ForallX HasSpan x => HasSpan (Exp x) where
getSpan (Var ex _) = getSpan ex
getSpan (Abs ex _ _) = getSpan ex
getSpan (Lam ex _ _) = getSpan ex
getSpan (App 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 (Lam ex x n) sp = Lam (setSpan ex sp) x n
setSpan (App ex l m) sp = App (setSpan ex sp) l m
setSpan (New ex) sp = New (setSpan ex sp)
......@@ -209,4 +221,6 @@ pattern L s m <- (getSpan' -> (s , m))
par :: Exp Ps -> Exp Ps
par l@(L sp m) = Par sp l
-- or,
-- = L sp (Par noLoc l)
```
\ No newline at end of file