{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- This modules contains facilites for providing meta-information for
-- program terms, especially node labeling
module Cubix.Language.Info
  (
    SourcePos
  , sourceFile
  , sourceRow
  , sourceCol

  , SourceSpan
  , sourceStart
  , sourceEnd
  , mkSourceSpan

  , Attrs
  , attrLabel
  , attrSpan

  , Label -- opaque!
  , HasLabel(..)
  , TermLab
  , MonadLabeler(..)
  , ppLabel
  , LabelGen -- opaque!
  , HasLabelGen(..)
  , mkCSLabelGen
  , unsafeMkCSLabelGen
  , debugMakeLabel
  , nextLabel

  , annotateLabel
  , annotateOuter
  , annotateLabelOuter
  , labelProg
  , annotateTop
  , annotateTop'

  , Project
  , parseProject
  , rewriteProjectM
  , rewriteProjectWithFilM
  , putProject

  , HFixLab
  ) where

import Control.Concurrent.Supply ( Supply, newSupply, freshId, splitSupply )
import Control.DeepSeq ( NFData(..) )
import Control.DeepSeq.Generics ( genericRnf )
import Control.Lens ( Lens', (&), (.~), (^.), use, (.=) )
import Control.Lens.TH ( makeClassy, makeLenses )
import Control.Monad ( liftM, forM_ )
import Control.Monad.IO.Class ( MonadIO(..) )
import Control.Monad.State ( MonadState, StateT(..), state, runState )
import Control.Monad.Trans.Maybe ( MaybeT(..) )

import Data.Data ( Data )
import Data.Map ( Map )
import qualified Data.Map as Map
import Data.Typeable ( Typeable )

import GHC.Generics ( Generic )

import System.IO.Unsafe ( unsafePerformIO )

import Data.Comp.Multi ( AnnTerm, AnnHFix, All, Cxt(..), Context, appCxt, Term, (:&:)(..), (:<:), CxtFunM, inj, HTraversable, E(..), rewriteEM, HFix , HFunctor, HFoldable)

import Cubix.Sin.Compdata.Annotation ( MonadAnnotater(..), annotateM )

--------------------------------------------------------------------------------
-- Labeling
--------------------------------------------------------------------------------
                          
-- | Provides unique labels for AST nodes
newtype Label = Label Int
  deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Eq Label
Eq Label =>
(Label -> Label -> Ordering)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Label)
-> (Label -> Label -> Label)
-> Ord Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
$cp1Ord :: Eq Label
Ord, ReadPrec [Label]
ReadPrec Label
Int -> ReadS Label
ReadS [Label]
(Int -> ReadS Label)
-> ReadS [Label]
-> ReadPrec Label
-> ReadPrec [Label]
-> Read Label
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Label]
$creadListPrec :: ReadPrec [Label]
readPrec :: ReadPrec Label
$creadPrec :: ReadPrec Label
readList :: ReadS [Label]
$creadList :: ReadS [Label]
readsPrec :: Int -> ReadS Label
$creadsPrec :: Int -> ReadS Label
Read, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show, Typeable, Typeable Label
DataType
Constr
Typeable Label =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Label -> c Label)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Label)
-> (Label -> Constr)
-> (Label -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Label))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label))
-> ((forall b. Data b => b -> b) -> Label -> Label)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r)
-> (forall u. (forall d. Data d => d -> u) -> Label -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Label -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Label -> m Label)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Label -> m Label)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Label -> m Label)
-> Data Label
Label -> DataType
Label -> Constr
(forall b. Data b => b -> b) -> Label -> Label
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Label -> c Label
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Label
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Label -> u
forall u. (forall d. Data d => d -> u) -> Label -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Label -> m Label
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Label -> m Label
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Label
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Label -> c Label
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Label)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label)
$cLabel :: Constr
$tLabel :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Label -> m Label
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Label -> m Label
gmapMp :: (forall d. Data d => d -> m d) -> Label -> m Label
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Label -> m Label
gmapM :: (forall d. Data d => d -> m d) -> Label -> m Label
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Label -> m Label
gmapQi :: Int -> (forall d. Data d => d -> u) -> Label -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Label -> u
gmapQ :: (forall d. Data d => d -> u) -> Label -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Label -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
gmapT :: (forall b. Data b => b -> b) -> Label -> Label
$cgmapT :: (forall b. Data b => b -> b) -> Label -> Label
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Label)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Label)
dataTypeOf :: Label -> DataType
$cdataTypeOf :: Label -> DataType
toConstr :: Label -> Constr
$ctoConstr :: Label -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Label
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Label
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Label -> c Label
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Label -> c Label
$cp1Data :: Typeable Label
Data, (forall x. Label -> Rep Label x)
-> (forall x. Rep Label x -> Label) -> Generic Label
forall x. Rep Label x -> Label
forall x. Label -> Rep Label x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Label x -> Label
$cfrom :: forall x. Label -> Rep Label x
Generic)

instance NFData Label where rnf :: Label -> ()
rnf = Label -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

makeClassy ''Label

data SourcePos = SourcePos { SourcePos -> String
_sourceFile :: !String
                           , SourcePos -> Int
_sourceRow  :: !Int
                           , SourcePos -> Int
_sourceCol  :: !Int
                           }
  deriving (SourcePos -> SourcePos -> Bool
(SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool) -> Eq SourcePos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcePos -> SourcePos -> Bool
$c/= :: SourcePos -> SourcePos -> Bool
== :: SourcePos -> SourcePos -> Bool
$c== :: SourcePos -> SourcePos -> Bool
Eq, Eq SourcePos
Eq SourcePos =>
(SourcePos -> SourcePos -> Ordering)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> SourcePos)
-> (SourcePos -> SourcePos -> SourcePos)
-> Ord SourcePos
SourcePos -> SourcePos -> Bool
SourcePos -> SourcePos -> Ordering
SourcePos -> SourcePos -> SourcePos
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourcePos -> SourcePos -> SourcePos
$cmin :: SourcePos -> SourcePos -> SourcePos
max :: SourcePos -> SourcePos -> SourcePos
$cmax :: SourcePos -> SourcePos -> SourcePos
>= :: SourcePos -> SourcePos -> Bool
$c>= :: SourcePos -> SourcePos -> Bool
> :: SourcePos -> SourcePos -> Bool
$c> :: SourcePos -> SourcePos -> Bool
<= :: SourcePos -> SourcePos -> Bool
$c<= :: SourcePos -> SourcePos -> Bool
< :: SourcePos -> SourcePos -> Bool
$c< :: SourcePos -> SourcePos -> Bool
compare :: SourcePos -> SourcePos -> Ordering
$ccompare :: SourcePos -> SourcePos -> Ordering
$cp1Ord :: Eq SourcePos
Ord, ReadPrec [SourcePos]
ReadPrec SourcePos
Int -> ReadS SourcePos
ReadS [SourcePos]
(Int -> ReadS SourcePos)
-> ReadS [SourcePos]
-> ReadPrec SourcePos
-> ReadPrec [SourcePos]
-> Read SourcePos
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourcePos]
$creadListPrec :: ReadPrec [SourcePos]
readPrec :: ReadPrec SourcePos
$creadPrec :: ReadPrec SourcePos
readList :: ReadS [SourcePos]
$creadList :: ReadS [SourcePos]
readsPrec :: Int -> ReadS SourcePos
$creadsPrec :: Int -> ReadS SourcePos
Read, Int -> SourcePos -> ShowS
[SourcePos] -> ShowS
SourcePos -> String
(Int -> SourcePos -> ShowS)
-> (SourcePos -> String)
-> ([SourcePos] -> ShowS)
-> Show SourcePos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourcePos] -> ShowS
$cshowList :: [SourcePos] -> ShowS
show :: SourcePos -> String
$cshow :: SourcePos -> String
showsPrec :: Int -> SourcePos -> ShowS
$cshowsPrec :: Int -> SourcePos -> ShowS
Show, Typeable, Typeable SourcePos
DataType
Constr
Typeable SourcePos =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SourcePos -> c SourcePos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourcePos)
-> (SourcePos -> Constr)
-> (SourcePos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourcePos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos))
-> ((forall b. Data b => b -> b) -> SourcePos -> SourcePos)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourcePos -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourcePos -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourcePos -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourcePos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> Data SourcePos
SourcePos -> DataType
SourcePos -> Constr
(forall b. Data b => b -> b) -> SourcePos -> SourcePos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourcePos -> u
forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourcePos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
$cSourcePos :: Constr
$tSourcePos :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapMp :: (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapM :: (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapQi :: Int -> (forall d. Data d => d -> u) -> SourcePos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourcePos -> u
gmapQ :: (forall d. Data d => d -> u) -> SourcePos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
gmapT :: (forall b. Data b => b -> b) -> SourcePos -> SourcePos
$cgmapT :: (forall b. Data b => b -> b) -> SourcePos -> SourcePos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SourcePos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourcePos)
dataTypeOf :: SourcePos -> DataType
$cdataTypeOf :: SourcePos -> DataType
toConstr :: SourcePos -> Constr
$ctoConstr :: SourcePos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
$cp1Data :: Typeable SourcePos
Data, (forall x. SourcePos -> Rep SourcePos x)
-> (forall x. Rep SourcePos x -> SourcePos) -> Generic SourcePos
forall x. Rep SourcePos x -> SourcePos
forall x. SourcePos -> Rep SourcePos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourcePos x -> SourcePos
$cfrom :: forall x. SourcePos -> Rep SourcePos x
Generic)

instance NFData SourcePos where rnf :: SourcePos -> ()
rnf = SourcePos -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

makeClassy ''SourcePos

data SourceSpan = SourceSpan { SourceSpan -> SourcePos
_sourceStart :: !SourcePos, SourceSpan -> SourcePos
_sourceEnd :: !SourcePos } deriving (SourceSpan -> SourceSpan -> Bool
(SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> Bool) -> Eq SourceSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceSpan -> SourceSpan -> Bool
$c/= :: SourceSpan -> SourceSpan -> Bool
== :: SourceSpan -> SourceSpan -> Bool
$c== :: SourceSpan -> SourceSpan -> Bool
Eq, Eq SourceSpan
Eq SourceSpan =>
(SourceSpan -> SourceSpan -> Ordering)
-> (SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> SourceSpan)
-> (SourceSpan -> SourceSpan -> SourceSpan)
-> Ord SourceSpan
SourceSpan -> SourceSpan -> Bool
SourceSpan -> SourceSpan -> Ordering
SourceSpan -> SourceSpan -> SourceSpan
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourceSpan -> SourceSpan -> SourceSpan
$cmin :: SourceSpan -> SourceSpan -> SourceSpan
max :: SourceSpan -> SourceSpan -> SourceSpan
$cmax :: SourceSpan -> SourceSpan -> SourceSpan
>= :: SourceSpan -> SourceSpan -> Bool
$c>= :: SourceSpan -> SourceSpan -> Bool
> :: SourceSpan -> SourceSpan -> Bool
$c> :: SourceSpan -> SourceSpan -> Bool
<= :: SourceSpan -> SourceSpan -> Bool
$c<= :: SourceSpan -> SourceSpan -> Bool
< :: SourceSpan -> SourceSpan -> Bool
$c< :: SourceSpan -> SourceSpan -> Bool
compare :: SourceSpan -> SourceSpan -> Ordering
$ccompare :: SourceSpan -> SourceSpan -> Ordering
$cp1Ord :: Eq SourceSpan
Ord, ReadPrec [SourceSpan]
ReadPrec SourceSpan
Int -> ReadS SourceSpan
ReadS [SourceSpan]
(Int -> ReadS SourceSpan)
-> ReadS [SourceSpan]
-> ReadPrec SourceSpan
-> ReadPrec [SourceSpan]
-> Read SourceSpan
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourceSpan]
$creadListPrec :: ReadPrec [SourceSpan]
readPrec :: ReadPrec SourceSpan
$creadPrec :: ReadPrec SourceSpan
readList :: ReadS [SourceSpan]
$creadList :: ReadS [SourceSpan]
readsPrec :: Int -> ReadS SourceSpan
$creadsPrec :: Int -> ReadS SourceSpan
Read, Int -> SourceSpan -> ShowS
[SourceSpan] -> ShowS
SourceSpan -> String
(Int -> SourceSpan -> ShowS)
-> (SourceSpan -> String)
-> ([SourceSpan] -> ShowS)
-> Show SourceSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceSpan] -> ShowS
$cshowList :: [SourceSpan] -> ShowS
show :: SourceSpan -> String
$cshow :: SourceSpan -> String
showsPrec :: Int -> SourceSpan -> ShowS
$cshowsPrec :: Int -> SourceSpan -> ShowS
Show, Typeable, Typeable SourceSpan
DataType
Constr
Typeable SourceSpan =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SourceSpan -> c SourceSpan)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceSpan)
-> (SourceSpan -> Constr)
-> (SourceSpan -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceSpan))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceSpan))
-> ((forall b. Data b => b -> b) -> SourceSpan -> SourceSpan)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceSpan -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceSpan -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourceSpan -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceSpan -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan)
-> Data SourceSpan
SourceSpan -> DataType
SourceSpan -> Constr
(forall b. Data b => b -> b) -> SourceSpan -> SourceSpan
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceSpan -> c SourceSpan
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceSpan
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourceSpan -> u
forall u. (forall d. Data d => d -> u) -> SourceSpan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceSpan -> c SourceSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceSpan)
$cSourceSpan :: Constr
$tSourceSpan :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
gmapMp :: (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
gmapM :: (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
gmapQi :: Int -> (forall d. Data d => d -> u) -> SourceSpan -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceSpan -> u
gmapQ :: (forall d. Data d => d -> u) -> SourceSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceSpan -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
gmapT :: (forall b. Data b => b -> b) -> SourceSpan -> SourceSpan
$cgmapT :: (forall b. Data b => b -> b) -> SourceSpan -> SourceSpan
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceSpan)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SourceSpan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceSpan)
dataTypeOf :: SourceSpan -> DataType
$cdataTypeOf :: SourceSpan -> DataType
toConstr :: SourceSpan -> Constr
$ctoConstr :: SourceSpan -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceSpan
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceSpan -> c SourceSpan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceSpan -> c SourceSpan
$cp1Data :: Typeable SourceSpan
Data, (forall x. SourceSpan -> Rep SourceSpan x)
-> (forall x. Rep SourceSpan x -> SourceSpan) -> Generic SourceSpan
forall x. Rep SourceSpan x -> SourceSpan
forall x. SourceSpan -> Rep SourceSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceSpan x -> SourceSpan
$cfrom :: forall x. SourceSpan -> Rep SourceSpan x
Generic)

makeClassy ''SourceSpan

mkSourceSpan :: String -> (Int, Int ) -> (Int, Int) -> SourceSpan
mkSourceSpan :: String -> (Int, Int) -> (Int, Int) -> SourceSpan
mkSourceSpan fileName :: String
fileName (sRow :: Int
sRow, sCol :: Int
sCol) (eRow :: Int
eRow, eCol :: Int
eCol) = SourcePos -> SourcePos -> SourceSpan
SourceSpan (String -> Int -> Int -> SourcePos
SourcePos String
fileName Int
sRow Int
sCol)
                                                             (String -> Int -> Int -> SourcePos
SourcePos String
fileName Int
eRow Int
eCol)

data Attrs = Attrs { Attrs -> Label
_attrLabel :: !Label
                   , Attrs -> Maybe SourceSpan
_attrSpan  :: !(Maybe SourceSpan)
                   }

makeClassy ''Attrs


type TermLab f   = AnnTerm Label f
type TermAttrs f = AnnTerm Attrs f

type HFixLab f   = AnnHFix Label f
type HFixAttrs f = AnnHFix Attrs f

ppLabel :: Label -> String
ppLabel :: Label -> String
ppLabel (Label n :: Int
n) = Int -> String
forall a. Show a => a -> String
show Int
n

data LabelGen = forall a. LabelGenInterface a => LabelGen a

class LabelGenInterface g where
  genLabel :: g -> (Label, LabelGen)
  split    :: g -> (LabelGen, LabelGen)

class HasLabelGen s where
  labelGen :: Lens' s LabelGen

instance HasLabelGen LabelGen where
  labelGen :: (LabelGen -> f LabelGen) -> LabelGen -> f LabelGen
labelGen = (LabelGen -> f LabelGen) -> LabelGen -> f LabelGen
forall a. a -> a
id

class (MonadState s m, HasLabelGen s) => MonadLabeler s m | m -> s
instance (MonadState s m, HasLabelGen s) => MonadLabeler s m

instance (Monad m, MonadLabeler s m) => MonadAnnotater Label m where
  annM :: f e l -> m ((:&:) f Label e l)
annM t :: f e l
t = f e l -> Label -> (:&:) f Label e l
forall k (f :: (* -> *) -> k -> *) a (g :: * -> *) (e :: k).
f g e -> a -> (:&:) f a g e
(:&:) f e l
t (Label -> (:&:) f Label e l) -> m Label -> m ((:&:) f Label e l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Label
forall s (m :: * -> *). MonadLabeler s m => m Label
nextLabel

-- | Allows embedding a smaller state inside a larger one
-- This has major advantages over 'Control.Lens.Zoom.zoom' in
-- that it doesn't require an explicit monad stack.
--
-- However, it runs the risk of behavior changing due to noncommutative
-- monad transformers (accessed via e.g.: @lift . put@), and is incompatible
-- with RWST.
zoom :: (MonadState s m) => Lens' s t -> StateT t m a -> m a
zoom :: Lens' s t -> StateT t m a -> m a
zoom f :: Lens' s t
f m :: StateT t m a
m = do t
s <- Getting t s t -> m t
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting t s t
Lens' s t
f
              (a :: a
a, s' :: t
s') <- StateT t m a -> t -> m (a, t)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT t m a
m t
s
              (t -> Identity t) -> s -> Identity s
Lens' s t
f ((t -> Identity t) -> s -> Identity s) -> t -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= t
s'
              a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

nextLabel :: (MonadLabeler s m) => m Label
nextLabel :: m Label
nextLabel = Lens' s LabelGen -> StateT LabelGen m Label -> m Label
forall s (m :: * -> *) t a.
MonadState s m =>
Lens' s t -> StateT t m a -> m a
zoom forall s. HasLabelGen s => Lens' s LabelGen
Lens' s LabelGen
labelGen (StateT LabelGen m Label -> m Label)
-> StateT LabelGen m Label -> m Label
forall a b. (a -> b) -> a -> b
$ (LabelGen -> (Label, LabelGen)) -> StateT LabelGen m Label
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(LabelGen g :: a
g) -> a -> (Label, LabelGen)
forall g. LabelGenInterface g => g -> (Label, LabelGen)
genLabel a
g)

--------------------------------------------------------------------------------

data ConcurrentSupplyLabelGen = ConcurrentSupplyLabelGen
    { ConcurrentSupplyLabelGen -> Supply
_supply :: Supply
    }
  deriving ( ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
(ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> Eq ConcurrentSupplyLabelGen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c/= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
== :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c== :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
Eq, Eq ConcurrentSupplyLabelGen
Eq ConcurrentSupplyLabelGen =>
(ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Ordering)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen
    -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> (ConcurrentSupplyLabelGen
    -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> Ord ConcurrentSupplyLabelGen
ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Ordering
ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
$cmin :: ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
max :: ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
$cmax :: ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
>= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c>= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
> :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c> :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
<= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c<= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
< :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c< :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
compare :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Ordering
$ccompare :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Ordering
$cp1Ord :: Eq ConcurrentSupplyLabelGen
Ord, Int -> ConcurrentSupplyLabelGen -> ShowS
[ConcurrentSupplyLabelGen] -> ShowS
ConcurrentSupplyLabelGen -> String
(Int -> ConcurrentSupplyLabelGen -> ShowS)
-> (ConcurrentSupplyLabelGen -> String)
-> ([ConcurrentSupplyLabelGen] -> ShowS)
-> Show ConcurrentSupplyLabelGen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConcurrentSupplyLabelGen] -> ShowS
$cshowList :: [ConcurrentSupplyLabelGen] -> ShowS
show :: ConcurrentSupplyLabelGen -> String
$cshow :: ConcurrentSupplyLabelGen -> String
showsPrec :: Int -> ConcurrentSupplyLabelGen -> ShowS
$cshowsPrec :: Int -> ConcurrentSupplyLabelGen -> ShowS
Show )

makeLenses ''ConcurrentSupplyLabelGen

mkCSLabelGen :: MonadIO m => m LabelGen
mkCSLabelGen :: m LabelGen
mkCSLabelGen = do Supply
s <- IO Supply -> m Supply
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Supply
newSupply
                  LabelGen -> m LabelGen
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelGen -> m LabelGen) -> LabelGen -> m LabelGen
forall a b. (a -> b) -> a -> b
$ ConcurrentSupplyLabelGen -> LabelGen
forall a. LabelGenInterface a => a -> LabelGen
LabelGen (ConcurrentSupplyLabelGen -> LabelGen)
-> ConcurrentSupplyLabelGen -> LabelGen
forall a b. (a -> b) -> a -> b
$ ConcurrentSupplyLabelGen :: Supply -> ConcurrentSupplyLabelGen
ConcurrentSupplyLabelGen { _supply :: Supply
_supply = Supply
s }

unsafeMkCSLabelGen :: () -> LabelGen
unsafeMkCSLabelGen :: () -> LabelGen
unsafeMkCSLabelGen () = IO LabelGen -> LabelGen
forall a. IO a -> a
unsafePerformIO IO LabelGen
forall (m :: * -> *). MonadIO m => m LabelGen
mkCSLabelGen
{-# NOINLINE unsafeMkCSLabelGen #-}

debugMakeLabel :: Int -> Label
debugMakeLabel :: Int -> Label
debugMakeLabel = Int -> Label
Label

instance LabelGenInterface ConcurrentSupplyLabelGen where
  genLabel :: ConcurrentSupplyLabelGen -> (Label, LabelGen)
genLabel g :: ConcurrentSupplyLabelGen
g = ( Int -> Label
Label Int
l
               , ConcurrentSupplyLabelGen -> LabelGen
forall a. LabelGenInterface a => a -> LabelGen
LabelGen (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> ConcurrentSupplyLabelGen
forall a b. a -> (a -> b) -> b
& (Supply -> Identity Supply)
-> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen
Iso' ConcurrentSupplyLabelGen Supply
supply ((Supply -> Identity Supply)
 -> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen)
-> Supply -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Supply
s)
               )
    where
      (l :: Int
l, s :: Supply
s) = Supply -> (Int, Supply)
freshId (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> Getting Supply ConcurrentSupplyLabelGen Supply -> Supply
forall s a. s -> Getting a s a -> a
^. Getting Supply ConcurrentSupplyLabelGen Supply
Iso' ConcurrentSupplyLabelGen Supply
supply)

  split :: ConcurrentSupplyLabelGen -> (LabelGen, LabelGen)
split g :: ConcurrentSupplyLabelGen
g = ( ConcurrentSupplyLabelGen -> LabelGen
forall a. LabelGenInterface a => a -> LabelGen
LabelGen (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> ConcurrentSupplyLabelGen
forall a b. a -> (a -> b) -> b
& (Supply -> Identity Supply)
-> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen
Iso' ConcurrentSupplyLabelGen Supply
supply ((Supply -> Identity Supply)
 -> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen)
-> Supply -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Supply
s)
            , ConcurrentSupplyLabelGen -> LabelGen
forall a. LabelGenInterface a => a -> LabelGen
LabelGen (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> ConcurrentSupplyLabelGen
forall a b. a -> (a -> b) -> b
& (Supply -> Identity Supply)
-> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen
Iso' ConcurrentSupplyLabelGen Supply
supply ((Supply -> Identity Supply)
 -> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen)
-> Supply -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Supply
s')
            )
    where
      (s :: Supply
s,s' :: Supply
s') = Supply -> (Supply, Supply)
splitSupply (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> Getting Supply ConcurrentSupplyLabelGen Supply -> Supply
forall s a. s -> Getting a s a -> a
^. Getting Supply ConcurrentSupplyLabelGen Supply
Iso' ConcurrentSupplyLabelGen Supply
supply)

--------------------------------------------------------------------------------

labelToAttrs :: (f :&: Label) e l -> (f :&: Attrs) e l
labelToAttrs :: (:&:) f Label e l -> (:&:) f Attrs e l
labelToAttrs (x :: f e l
x :&: l :: Label
l) = f e l
x f e l -> Attrs -> (:&:) f Attrs e l
forall k (f :: (* -> *) -> k -> *) a (g :: * -> *) (e :: k).
f g e -> a -> (:&:) f a g e
:&: Label -> Maybe SourceSpan -> Attrs
Attrs Label
l Maybe SourceSpan
forall a. Maybe a
Nothing


-- | Fully annotates a term with fresh labels
annotateLabel :: (HTraversable f, MonadAnnotater Label m) => CxtFunM m f (f :&: Label)
annotateLabel :: CxtFunM m f (f :&: Label)
annotateLabel = Cxt h f a i -> m (Cxt h (f :&: Label) a i)
forall (f :: (* -> *) -> * -> *) a (m :: * -> *).
(HTraversable f, MonadAnnotater a m) =>
CxtFunM m f (f :&: a)
annotateM

annotateOuter :: (HTraversable f, MonadAnnotater a m) => Context f (AnnHFix a f) l -> m (AnnHFix a f l)
annotateOuter :: Context f (AnnHFix a f) l -> m (AnnHFix a f l)
annotateOuter = (Context (f :&: a) (AnnHFix a f) l -> AnnHFix a f l)
-> m (Context (f :&: a) (AnnHFix a f) l) -> m (AnnHFix a f l)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Context (f :&: a) (AnnHFix a f) l -> AnnHFix a f l
forall (f :: (* -> *) -> * -> *) h (a :: * -> *).
HFunctor f =>
Context f (Cxt h f a) :-> Cxt h f a
appCxt (m (Context (f :&: a) (AnnHFix a f) l) -> m (AnnHFix a f l))
-> (Context f (AnnHFix a f) l
    -> m (Context (f :&: a) (AnnHFix a f) l))
-> Context f (AnnHFix a f) l
-> m (AnnHFix a f l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context f (AnnHFix a f) l -> m (Context (f :&: a) (AnnHFix a f) l)
forall (f :: (* -> *) -> * -> *) a (m :: * -> *).
(HTraversable f, MonadAnnotater a m) =>
CxtFunM m f (f :&: a)
annotateM

annotateLabelOuter :: (HTraversable f, MonadAnnotater Label m) => Context f (HFixLab f) l -> m (HFixLab f l)
annotateLabelOuter :: Context f (HFixLab f) l -> m (HFixLab f l)
annotateLabelOuter = Context f (HFixLab f) l -> m (HFixLab f l)
forall (f :: (* -> *) -> * -> *) a (m :: * -> *) l.
(HTraversable f, MonadAnnotater a m) =>
Context f (AnnHFix a f) l -> m (AnnHFix a f l)
annotateOuter

labelProg' :: (HTraversable f) => LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
labelProg' :: LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
labelProg' gen :: LabelGen
gen t :: HFix f l
t = State LabelGen (HFixLab f l) -> LabelGen -> (HFixLab f l, LabelGen)
forall s a. State s a -> s -> (a, s)
runState (HFix f l -> State LabelGen (HFixLab f l)
forall (f :: (* -> *) -> * -> *) (m :: * -> *).
(HTraversable f, MonadAnnotater Label m) =>
CxtFunM m f (f :&: Label)
annotateLabel HFix f l
t) LabelGen
gen

labelProg :: (HTraversable f) => LabelGen -> HFix f l -> HFixLab f l
labelProg :: LabelGen -> HFix f l -> HFixLab f l
labelProg gen :: LabelGen
gen t :: HFix f l
t = (HFixLab f l, LabelGen) -> HFixLab f l
forall a b. (a, b) -> a
fst ((HFixLab f l, LabelGen) -> HFixLab f l)
-> (HFixLab f l, LabelGen) -> HFixLab f l
forall a b. (a -> b) -> a -> b
$ LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
forall (f :: (* -> *) -> * -> *) l.
HTraversable f =>
LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
labelProg' LabelGen
gen HFix f l
t

annotateTop :: (MonadAnnotater Label m) => f (HFixLab f) l -> m (HFixLab f l)
annotateTop :: f (HFixLab f) l -> m (HFixLab f l)
annotateTop = ((:&:) f Label (HFixLab f) l -> HFixLab f l)
-> m ((:&:) f Label (HFixLab f) l) -> m (HFixLab f l)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (:&:) f Label (HFixLab f) l -> HFixLab f l
forall (f :: (* -> *) -> * -> *) h (a :: * -> *) i.
f (Cxt h f a) i -> Cxt h f a i
Term (m ((:&:) f Label (HFixLab f) l) -> m (HFixLab f l))
-> (f (HFixLab f) l -> m ((:&:) f Label (HFixLab f) l))
-> f (HFixLab f) l
-> m (HFixLab f l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (HFixLab f) l -> m ((:&:) f Label (HFixLab f) l)
forall a (m :: * -> *) (f :: (* -> *) -> * -> *) (e :: * -> *) l.
MonadAnnotater a m =>
f e l -> m ((:&:) f a e l)
annM

annotateTop' :: (f :<: g, MonadAnnotater Label m) => f (HFixLab g) l -> m (HFixLab g l)
annotateTop' :: f (HFixLab g) l -> m (HFixLab g l)
annotateTop' = g (HFixLab g) l -> m (HFixLab g l)
forall (m :: * -> *) (f :: (* -> *) -> * -> *) l.
MonadAnnotater Label m =>
f (HFixLab f) l -> m (HFixLab f l)
annotateTop (g (HFixLab g) l -> m (HFixLab g l))
-> (f (HFixLab g) l -> g (HFixLab g) l)
-> f (HFixLab g) l
-> m (HFixLab g l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (HFixLab g) l -> g (HFixLab g) l
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (a :: * -> *).
(f :<: g) =>
f a :-> g a
inj

annotateTopAttrs :: (MonadAnnotater Label m) => f (HFixAttrs f) l -> m (HFixAttrs f l)
annotateTopAttrs :: f (HFixAttrs f) l -> m (HFixAttrs f l)
annotateTopAttrs = ((:&:) f Attrs (HFixAttrs f) l -> HFixAttrs f l)
-> m ((:&:) f Attrs (HFixAttrs f) l) -> m (HFixAttrs f l)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (:&:) f Attrs (HFixAttrs f) l -> HFixAttrs f l
forall (f :: (* -> *) -> * -> *) h (a :: * -> *) i.
f (Cxt h f a) i -> Cxt h f a i
Term (m ((:&:) f Attrs (HFixAttrs f) l) -> m (HFixAttrs f l))
-> (f (HFixAttrs f) l -> m ((:&:) f Attrs (HFixAttrs f) l))
-> f (HFixAttrs f) l
-> m (HFixAttrs f l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((:&:) f Label (HFixAttrs f) l -> (:&:) f Attrs (HFixAttrs f) l)
-> m ((:&:) f Label (HFixAttrs f) l)
-> m ((:&:) f Attrs (HFixAttrs f) l)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (:&:) f Label (HFixAttrs f) l -> (:&:) f Attrs (HFixAttrs f) l
forall (f :: (* -> *) -> * -> *) (e :: * -> *) l.
(:&:) f Label e l -> (:&:) f Attrs e l
labelToAttrs (m ((:&:) f Label (HFixAttrs f) l)
 -> m ((:&:) f Attrs (HFixAttrs f) l))
-> (f (HFixAttrs f) l -> m ((:&:) f Label (HFixAttrs f) l))
-> f (HFixAttrs f) l
-> m ((:&:) f Attrs (HFixAttrs f) l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (HFixAttrs f) l -> m ((:&:) f Label (HFixAttrs f) l)
forall a (m :: * -> *) (f :: (* -> *) -> * -> *) (e :: * -> *) l.
MonadAnnotater a m =>
f e l -> m ((:&:) f a e l)
annM

annotateTopAttrs' :: (f :<: g, MonadAnnotater Label m) => f (HFixAttrs g) l -> m (HFixAttrs g l)
annotateTopAttrs' :: f (HFixAttrs g) l -> m (HFixAttrs g l)
annotateTopAttrs' = g (HFixAttrs g) l -> m (HFixAttrs g l)
forall (m :: * -> *) (f :: (* -> *) -> * -> *) l.
MonadAnnotater Label m =>
f (HFixAttrs f) l -> m (HFixAttrs f l)
annotateTopAttrs (g (HFixAttrs g) l -> m (HFixAttrs g l))
-> (f (HFixAttrs g) l -> g (HFixAttrs g) l)
-> f (HFixAttrs g) l
-> m (HFixAttrs g l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (HFixAttrs g) l -> g (HFixAttrs g) l
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (a :: * -> *).
(f :<: g) =>
f a :-> g a
inj

--------------------------------------------------------------------------------

type Project fs = Map FilePath (E (TermLab fs))

parseProject ::
  forall fs l.
  ( All HFoldable fs
  , All HFunctor fs
  , All HTraversable fs
  ) => LabelGen -> (FilePath -> IO (Maybe (Term fs l))) -> [FilePath] -> IO (Maybe (Project fs))
parseProject :: LabelGen
-> (String -> IO (Maybe (Term fs l)))
-> [String]
-> IO (Maybe (Project fs))
parseProject gen :: LabelGen
gen parse :: String -> IO (Maybe (Term fs l))
parse fils :: [String]
fils = MaybeT IO (Project fs) -> IO (Maybe (Project fs))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT ((All HFoldable fs, All HFunctor fs, All HTraversable fs) =>
LabelGen -> [String] -> MaybeT IO (Project fs)
LabelGen -> [String] -> MaybeT IO (Project fs)
go LabelGen
gen [String]
fils)
  where
    go :: (All HFoldable fs, All HFunctor fs, All HTraversable fs) => LabelGen -> [FilePath] -> MaybeT IO (Project fs)
    go :: LabelGen -> [String] -> MaybeT IO (Project fs)
go gen :: LabelGen
gen []         = Project fs -> MaybeT IO (Project fs)
forall (m :: * -> *) a. Monad m => a -> m a
return Project fs
forall k a. Map k a
Map.empty
    go gen :: LabelGen
gen (fil :: String
fil:fils :: [String]
fils) = do Term fs l
t <- IO (Maybe (Term fs l)) -> MaybeT IO (Term fs l)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (Term fs l)) -> MaybeT IO (Term fs l))
-> IO (Maybe (Term fs l)) -> MaybeT IO (Term fs l)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe (Term fs l))
parse String
fil
                           let (tLab :: HFixLab (Sum fs) l
tLab, gen' :: LabelGen
gen') = LabelGen -> Term fs l -> (HFixLab (Sum fs) l, LabelGen)
forall (f :: (* -> *) -> * -> *) l.
HTraversable f =>
LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
labelProg' LabelGen
gen Term fs l
t
                           Project fs
prj <- (All HFoldable fs, All HFunctor fs, All HTraversable fs) =>
LabelGen -> [String] -> MaybeT IO (Project fs)
LabelGen -> [String] -> MaybeT IO (Project fs)
go LabelGen
gen' [String]
fils
                           Project fs -> MaybeT IO (Project fs)
forall (m :: * -> *) a. Monad m => a -> m a
return (Project fs -> MaybeT IO (Project fs))
-> Project fs -> MaybeT IO (Project fs)
forall a b. (a -> b) -> a -> b
$ String
-> E (Cxt NoHole (Sum fs :&: Label) (K ()))
-> Project fs
-> Project fs
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
fil (HFixLab (Sum fs) l -> E (Cxt NoHole (Sum fs :&: Label) (K ()))
forall (f :: * -> *) i. f i -> E f
E HFixLab (Sum fs) l
tLab) Project fs
prj

rewriteProjectM :: (Applicative m) => (forall l. TermLab fs l -> m (TermLab fs l)) -> Project fs -> m (Project fs)
rewriteProjectM :: (forall l. TermLab fs l -> m (TermLab fs l))
-> Project fs -> m (Project fs)
rewriteProjectM f :: forall l. TermLab fs l -> m (TermLab fs l)
f = (E (TermLab fs) -> m (E (TermLab fs)))
-> Project fs -> m (Project fs)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((forall l. TermLab fs l -> m (TermLab fs l))
-> E (TermLab fs) -> m (E (TermLab fs))
forall (m :: * -> *) (f :: * -> *).
Functor m =>
(forall l. f l -> m (f l)) -> E f -> m (E f)
rewriteEM forall l. TermLab fs l -> m (TermLab fs l)
f)

rewriteProjectWithFilM :: (Applicative m) => (forall l. FilePath -> TermLab fs l -> m (TermLab fs l)) -> Project fs -> m (Project fs)
rewriteProjectWithFilM :: (forall l. String -> TermLab fs l -> m (TermLab fs l))
-> Project fs -> m (Project fs)
rewriteProjectWithFilM f :: forall l. String -> TermLab fs l -> m (TermLab fs l)
f = (String -> E (TermLab fs) -> m (E (TermLab fs)))
-> Project fs -> m (Project fs)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (\k :: String
k t :: E (TermLab fs)
t -> (forall l. TermLab fs l -> m (TermLab fs l))
-> E (TermLab fs) -> m (E (TermLab fs))
forall (m :: * -> *) (f :: * -> *).
Functor m =>
(forall l. f l -> m (f l)) -> E f -> m (E f)
rewriteEM (String -> TermLab fs l -> m (TermLab fs l)
forall l. String -> TermLab fs l -> m (TermLab fs l)
f String
k) E (TermLab fs)
t)

putProject :: (forall l. TermLab fs l -> String) -> Project fs -> IO ()
putProject :: (forall l. TermLab fs l -> String) -> Project fs -> IO ()
putProject pp :: forall l. TermLab fs l -> String
pp prj :: Project fs
prj = [(String, E (TermLab fs))]
-> ((String, E (TermLab fs)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Project fs -> [(String, E (TermLab fs))]
forall k a. Map k a -> [(k, a)]
Map.toList Project fs
prj) (\(fil :: String
fil, E t :: TermLab fs i
t) -> String -> String -> IO ()
writeFile String
fil (TermLab fs i -> String
forall l. TermLab fs l -> String
pp TermLab fs i
t))