85 lines
2.2 KiB
Haskell
85 lines
2.2 KiB
Haskell
module Compiler.Types
|
|
( SrcSpan(..)
|
|
, srcspanLine, srcspanColumn, srcspanAbs, srcspanLen
|
|
, Located(..)
|
|
, nolo
|
|
, (<<~), (<~>)
|
|
|
|
-- * Re-exports
|
|
, Comonad
|
|
, Apply
|
|
, Bind
|
|
)
|
|
where
|
|
--------------------------------------------------------------------------------
|
|
import Control.Comonad
|
|
import Data.Functor.Apply
|
|
import Data.Functor.Bind
|
|
import Control.Lens hiding ((<<~))
|
|
import Language.Haskell.TH.Syntax (Lift)
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Token wrapped with a span (line, column, absolute, length)
|
|
data Located a = Located SrcSpan a
|
|
deriving (Show, Lift, Functor)
|
|
|
|
instance Apply Located where
|
|
liftF2 f (Located sa p) (Located sb q)
|
|
= Located (sa <> sb) (p `f` q)
|
|
|
|
instance Bind Located where
|
|
Located sa a >>- k = Located (sa <> sb) b
|
|
where
|
|
Located sb b = k a
|
|
|
|
instance Comonad Located where
|
|
extract (Located _ a) = a
|
|
extend ck w@(Located p _) = Located p (ck w)
|
|
|
|
data SrcSpan = SrcSpan
|
|
!Int -- ^ Line
|
|
!Int -- ^ Column
|
|
!Int -- ^ Absolute
|
|
!Int -- ^ Length
|
|
deriving (Show, Lift)
|
|
|
|
tupling :: Iso' SrcSpan (Int, Int, Int, Int)
|
|
tupling = iso (\ (SrcSpan a b c d) -> (a,b,c,d))
|
|
(\ (a,b,c,d) -> SrcSpan a b c d)
|
|
|
|
srcspanLine, srcspanColumn, srcspanAbs, srcspanLen :: Lens' SrcSpan Int
|
|
srcspanLine = tupling . _1
|
|
srcspanColumn = tupling . _2
|
|
srcspanAbs = tupling . _3
|
|
srcspanLen = tupling . _4
|
|
|
|
-- | debug tool
|
|
nolo :: a -> Located a
|
|
nolo = Located (SrcSpan 0 0 0 0)
|
|
|
|
instance Semigroup SrcSpan where
|
|
SrcSpan la ca aa sa <> SrcSpan lb cb ab sb = SrcSpan l c a s where
|
|
l = min la lb
|
|
c = min ca cb
|
|
a = min aa ab
|
|
s = case aa `compare` ab of
|
|
EQ -> max sa sb
|
|
LT -> max sa (ab + lb - aa)
|
|
GT -> max sb (aa + la - ab)
|
|
|
|
-- | A synonym for '(<<=)' with a tighter precedence and left-associativity for
|
|
-- use with '(<~>)' in a sort of, comonadic pseudo-applicative style.
|
|
|
|
(<<~) :: (Comonad w) => (w a -> b) -> w a -> w b
|
|
(<<~) = (<<=)
|
|
|
|
infixl 4 <<~
|
|
|
|
-- | Similar to '(<*>)', but with a cokleisli arrow.
|
|
|
|
(<~>) :: (Comonad w, Bind w) => w (w a -> b) -> w a -> w b
|
|
mc <~> ma = mc >>- \f -> ma =>> f
|
|
|
|
infixl 4 <~>
|
|
|