module CommonTypes (module Options, module CommonTypes) where
import Options
import UU.Scanner.Position(Pos)
import qualified Data.Map as Map
import Data.Map(Map)
import Data.Set(Set)
import qualified Data.Set as Set
import Data.Monoid(mappend,Monoid)
import Data.Char
import Pretty
type Blocks = Map BlockInfo [([String], Pos)]
type BlockInfo = (BlockKind, Maybe NontermIdent)
data BlockKind
= BlockImport
| BlockPragma
| BlockMain
| BlockData
| BlockRec
| BlockOther
deriving (BlockKind -> BlockKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockKind -> BlockKind -> Bool
$c/= :: BlockKind -> BlockKind -> Bool
== :: BlockKind -> BlockKind -> Bool
$c== :: BlockKind -> BlockKind -> Bool
Eq, Eq BlockKind
BlockKind -> BlockKind -> Bool
BlockKind -> BlockKind -> Ordering
BlockKind -> BlockKind -> BlockKind
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 :: BlockKind -> BlockKind -> BlockKind
$cmin :: BlockKind -> BlockKind -> BlockKind
max :: BlockKind -> BlockKind -> BlockKind
$cmax :: BlockKind -> BlockKind -> BlockKind
>= :: BlockKind -> BlockKind -> Bool
$c>= :: BlockKind -> BlockKind -> Bool
> :: BlockKind -> BlockKind -> Bool
$c> :: BlockKind -> BlockKind -> Bool
<= :: BlockKind -> BlockKind -> Bool
$c<= :: BlockKind -> BlockKind -> Bool
< :: BlockKind -> BlockKind -> Bool
$c< :: BlockKind -> BlockKind -> Bool
compare :: BlockKind -> BlockKind -> Ordering
$ccompare :: BlockKind -> BlockKind -> Ordering
Ord, Int -> BlockKind -> ShowS
[BlockKind] -> ShowS
BlockKind -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BlockKind] -> ShowS
$cshowList :: [BlockKind] -> ShowS
show :: BlockKind -> [Char]
$cshow :: BlockKind -> [Char]
showsPrec :: Int -> BlockKind -> ShowS
$cshowsPrec :: Int -> BlockKind -> ShowS
Show)
instance PP Identifier where
pp :: Identifier -> PP_Doc
pp = [Char] -> PP_Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> [Char]
getName
data Type = Haskell String
| NT Identifier [String]
Bool
| Self
deriving (Type -> Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq)
data ComplexType = List Type
| Tuple [(Identifier, Type)]
| Maybe Type
| Either Type Type
| Map Type Type
| IntMap Type
| OrdSet Type
| IntSet
instance Show ComplexType where
show :: ComplexType -> [Char]
show (List Type
t ) = [Char]
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t forall a. [a] -> [a] -> [a]
++ [Char]
"]"
show (Tuple [(Identifier, Type)]
ts) = [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> ShowS
showList [ forall a. Show a => a -> [Char]
show Identifier
n forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t | (Identifier
n,Type
t) <- [(Identifier, Type)]
ts ] [Char]
"" forall a. [a] -> [a] -> [a]
++ [Char]
")"
show (Maybe Type
t ) = [Char]
"Maybe " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t
show (Either Type
t1 Type
t2) = [Char]
"Either " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t1 forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t2
show (Map Type
t1 Type
t2) = [Char]
"Map " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t1 forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t2
show (IntMap Type
t1) = [Char]
"IntMap " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t1
show (OrdSet Type
t1) = [Char]
"Set" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Type
t1
show ComplexType
IntSet = [Char]
"IntSet"
instance Show Type where
show :: Type -> [Char]
show = Maybe Identifier -> [[Char]] -> Type -> [Char]
typeToHaskellString forall a. Maybe a
Nothing []
type Attributes = Map Identifier Type
type TypeSyns = [(NontermIdent,ComplexType)]
type ParamMap = Map NontermIdent [Identifier]
type AttrNames = [(Identifier,Type,(String,String,String))]
type UseMap = Map NontermIdent (Map Identifier (String,String,String))
type PragmaMap = Map NontermIdent (Map ConstructorIdent (Set Identifier))
type AttrMap = Map NontermIdent (Map ConstructorIdent (Set (Identifier,Identifier)))
type UniqueMap = Map NontermIdent (Map ConstructorIdent (Map Identifier Identifier))
type Derivings = Map NontermIdent (Set Identifier)
type ClassContext = [(Identifier, [String])]
type ContextMap = Map NontermIdent ClassContext
type QuantMap = Map NontermIdent [String]
type Strings = [String]
type ConstructorIdent = Identifier
type AttrOrderMap = Map NontermIdent (Map ConstructorIdent (Set Dependency))
type VisitIdentifier = Int
type StateIdentifier = Int
data Dependency = Dependency Occurrence Occurrence deriving (Dependency -> Dependency -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependency -> Dependency -> Bool
$c/= :: Dependency -> Dependency -> Bool
== :: Dependency -> Dependency -> Bool
$c== :: Dependency -> Dependency -> Bool
Eq,Eq Dependency
Dependency -> Dependency -> Bool
Dependency -> Dependency -> Ordering
Dependency -> Dependency -> Dependency
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 :: Dependency -> Dependency -> Dependency
$cmin :: Dependency -> Dependency -> Dependency
max :: Dependency -> Dependency -> Dependency
$cmax :: Dependency -> Dependency -> Dependency
>= :: Dependency -> Dependency -> Bool
$c>= :: Dependency -> Dependency -> Bool
> :: Dependency -> Dependency -> Bool
$c> :: Dependency -> Dependency -> Bool
<= :: Dependency -> Dependency -> Bool
$c<= :: Dependency -> Dependency -> Bool
< :: Dependency -> Dependency -> Bool
$c< :: Dependency -> Dependency -> Bool
compare :: Dependency -> Dependency -> Ordering
$ccompare :: Dependency -> Dependency -> Ordering
Ord,Int -> Dependency -> ShowS
[Dependency] -> ShowS
Dependency -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Dependency] -> ShowS
$cshowList :: [Dependency] -> ShowS
show :: Dependency -> [Char]
$cshow :: Dependency -> [Char]
showsPrec :: Int -> Dependency -> ShowS
$cshowsPrec :: Int -> Dependency -> ShowS
Show)
data Occurrence
= OccAttr Identifier Identifier
| OccRule Identifier
deriving (Occurrence -> Occurrence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Occurrence -> Occurrence -> Bool
$c/= :: Occurrence -> Occurrence -> Bool
== :: Occurrence -> Occurrence -> Bool
$c== :: Occurrence -> Occurrence -> Bool
Eq,Eq Occurrence
Occurrence -> Occurrence -> Bool
Occurrence -> Occurrence -> Ordering
Occurrence -> Occurrence -> Occurrence
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 :: Occurrence -> Occurrence -> Occurrence
$cmin :: Occurrence -> Occurrence -> Occurrence
max :: Occurrence -> Occurrence -> Occurrence
$cmax :: Occurrence -> Occurrence -> Occurrence
>= :: Occurrence -> Occurrence -> Bool
$c>= :: Occurrence -> Occurrence -> Bool
> :: Occurrence -> Occurrence -> Bool
$c> :: Occurrence -> Occurrence -> Bool
<= :: Occurrence -> Occurrence -> Bool
$c<= :: Occurrence -> Occurrence -> Bool
< :: Occurrence -> Occurrence -> Bool
$c< :: Occurrence -> Occurrence -> Bool
compare :: Occurrence -> Occurrence -> Ordering
$ccompare :: Occurrence -> Occurrence -> Ordering
Ord,Int -> Occurrence -> ShowS
[Occurrence] -> ShowS
Occurrence -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Occurrence] -> ShowS
$cshowList :: [Occurrence] -> ShowS
show :: Occurrence -> [Char]
$cshow :: Occurrence -> [Char]
showsPrec :: Int -> Occurrence -> ShowS
$cshowsPrec :: Int -> Occurrence -> ShowS
Show)
data ConstructorType
= DataConstructor
| RecordConstructor
deriving (ConstructorType -> ConstructorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstructorType -> ConstructorType -> Bool
$c/= :: ConstructorType -> ConstructorType -> Bool
== :: ConstructorType -> ConstructorType -> Bool
$c== :: ConstructorType -> ConstructorType -> Bool
Eq,Eq ConstructorType
ConstructorType -> ConstructorType -> Bool
ConstructorType -> ConstructorType -> Ordering
ConstructorType -> ConstructorType -> ConstructorType
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 :: ConstructorType -> ConstructorType -> ConstructorType
$cmin :: ConstructorType -> ConstructorType -> ConstructorType
max :: ConstructorType -> ConstructorType -> ConstructorType
$cmax :: ConstructorType -> ConstructorType -> ConstructorType
>= :: ConstructorType -> ConstructorType -> Bool
$c>= :: ConstructorType -> ConstructorType -> Bool
> :: ConstructorType -> ConstructorType -> Bool
$c> :: ConstructorType -> ConstructorType -> Bool
<= :: ConstructorType -> ConstructorType -> Bool
$c<= :: ConstructorType -> ConstructorType -> Bool
< :: ConstructorType -> ConstructorType -> Bool
$c< :: ConstructorType -> ConstructorType -> Bool
compare :: ConstructorType -> ConstructorType -> Ordering
$ccompare :: ConstructorType -> ConstructorType -> Ordering
Ord,Int -> ConstructorType -> ShowS
[ConstructorType] -> ShowS
ConstructorType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorType] -> ShowS
$cshowList :: [ConstructorType] -> ShowS
show :: ConstructorType -> [Char]
$cshow :: ConstructorType -> [Char]
showsPrec :: Int -> ConstructorType -> ShowS
$cshowsPrec :: Int -> ConstructorType -> ShowS
Show)
type AttrEnv = ( [Identifier]
, [(Identifier,Identifier)]
)
nullIdent, _LHS, _SELF, _LOC, _INST, _INST', _FIELD, _FIRST, _LAST :: Identifier
nullIdent :: Identifier
nullIdent = [Char] -> Identifier
identifier [Char]
""
_LHS :: Identifier
_LHS = [Char] -> Identifier
identifier [Char]
"lhs"
_SELF :: Identifier
_SELF = [Char] -> Identifier
identifier [Char]
"SELF"
_LOC :: Identifier
_LOC = [Char] -> Identifier
identifier [Char]
"loc"
_INST :: Identifier
_INST = [Char] -> Identifier
identifier [Char]
"inst"
_INST' :: Identifier
_INST' = [Char] -> Identifier
identifier [Char]
"inst'"
_FIELD :: Identifier
_FIELD = [Char] -> Identifier
identifier [Char]
"field"
_FIRST :: Identifier
_FIRST = [Char] -> Identifier
identifier [Char]
"first__"
_LAST :: Identifier
_LAST = [Char] -> Identifier
identifier [Char]
"last__"
idLateBindingAttr :: Identifier
idLateBindingAttr :: Identifier
idLateBindingAttr = [Char] -> Identifier
identifier [Char]
"lateSemDict"
lateBindingTypeNm :: String -> String
lateBindingTypeNm :: ShowS
lateBindingTypeNm [Char]
modNm = [Char]
"Late_" forall a. [a] -> [a] -> [a]
++ [Char]
modNm forall a. [a] -> [a] -> [a]
++ [Char]
"_"
lateBindingFieldNm :: String -> String
lateBindingFieldNm :: ShowS
lateBindingFieldNm [Char]
modNm = [Char]
"late_" forall a. [a] -> [a] -> [a]
++ [Char]
modNm forall a. [a] -> [a] -> [a]
++ [Char]
"_"
lateBindingType :: String -> Type
lateBindingType :: [Char] -> Type
lateBindingType [Char]
modNm = [Char] -> Type
Haskell (ShowS
lateBindingTypeNm [Char]
modNm)
lateSemNtLabel :: NontermIdent -> String
lateSemNtLabel :: Identifier -> [Char]
lateSemNtLabel Identifier
nt = [Char]
"mk_" forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
getName Identifier
nt
lateSemConLabel :: NontermIdent -> ConstructorIdent -> String
lateSemConLabel :: Identifier -> Identifier -> [Char]
lateSemConLabel Identifier
nt Identifier
con = [Char]
"mk_" forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
getName Identifier
nt forall a. [a] -> [a] -> [a]
++ [Char]
"_" forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
getName Identifier
con
sdtype :: NontermIdent -> String
sdtype :: Identifier -> [Char]
sdtype Identifier
nt = [Char]
"T_"forall a. [a] -> [a] -> [a]
++Identifier -> [Char]
getName Identifier
nt
mkNtType :: Identifier -> [String] -> Type
mkNtType :: Identifier -> [[Char]] -> Type
mkNtType Identifier
nt [[Char]]
args
| forall a. Int -> [a] -> [a]
take Int
2 (Identifier -> [Char]
getName Identifier
nt) forall a. Eq a => a -> a -> Bool
== [Char]
"T_" = let nt' :: Identifier
nt' = [Char] -> Pos -> Identifier
Ident (forall a. Int -> [a] -> [a]
drop Int
2 (Identifier -> [Char]
getName Identifier
nt)) (Identifier -> Pos
getPos Identifier
nt)
in Identifier -> [[Char]] -> Bool -> Type
NT Identifier
nt' [[Char]]
args Bool
True
| Bool
otherwise = Identifier -> [[Char]] -> Bool -> Type
NT Identifier
nt [[Char]]
args Bool
False
cataname :: String -> Identifier -> String
cataname :: [Char] -> Identifier -> [Char]
cataname [Char]
pre Identifier
name = [Char]
preforall a. [a] -> [a] -> [a]
++Identifier -> [Char]
getName Identifier
name
conname :: Bool -> NontermIdent -> ConstructorIdent -> String
conname :: Bool -> Identifier -> Identifier -> [Char]
conname Bool
ren Identifier
nt Identifier
con | Bool
ren = ShowS
capitalize (Identifier -> [Char]
getName Identifier
nt) forall a. [a] -> [a] -> [a]
++ [Char]
"_" forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
getName Identifier
con
| Bool
otherwise = Identifier -> [Char]
getName Identifier
con
capitalize :: String -> String
capitalize :: ShowS
capitalize [] = []
capitalize (Char
c:[Char]
cs) = Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: [Char]
cs
semname :: String -> NontermIdent -> ConstructorIdent -> String
semname :: [Char] -> Identifier -> Identifier -> [Char]
semname [Char]
pre Identifier
nt Identifier
con = [Char]
pre forall a. [a] -> [a] -> [a]
++ (Identifier -> [Char]
getName Identifier
nt forall a. [a] -> [a] -> [a]
++ [Char]
"_" forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
getName Identifier
con)
recordFieldname :: NontermIdent -> ConstructorIdent -> Identifier -> String
recordFieldname :: Identifier -> Identifier -> Identifier -> [Char]
recordFieldname Identifier
nt Identifier
con Identifier
nm = Identifier -> [Char]
getName Identifier
nm forall a. [a] -> [a] -> [a]
++ [Char]
"_" forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
getName Identifier
nt forall a. [a] -> [a] -> [a]
++ [Char]
"_" forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
getName Identifier
con
lhsname :: Options -> Bool -> Identifier -> String
lhsname :: Options -> Bool -> Identifier -> [Char]
lhsname Options
opts Bool
isIn = Options -> Bool -> Identifier -> Identifier -> [Char]
attrname Options
opts Bool
isIn Identifier
_LHS
attrname :: Options -> Bool -> Identifier -> Identifier -> String
attrname :: Options -> Bool -> Identifier -> Identifier -> [Char]
attrname Options
opts Bool
isIn Identifier
field Identifier
attr
| Identifier
field forall a. Eq a => a -> a -> Bool
== Identifier
_LOC = Options -> Identifier -> [Char]
locname Options
opts Identifier
attr
| Identifier
field forall a. Eq a => a -> a -> Bool
== Identifier
_INST = Identifier -> [Char]
instname Identifier
attr
| Identifier
field forall a. Eq a => a -> a -> Bool
== Identifier
_INST' = Identifier -> [Char]
inst'name Identifier
attr
| Identifier
field forall a. Eq a => a -> a -> Bool
== Identifier
_FIELD = Identifier -> [Char]
fieldname Identifier
attr
| Bool
otherwise = let direction :: [Char]
direction | Bool
isIn = [Char]
"I"
| Bool
otherwise = [Char]
"O"
pref :: Char
pref = if Options -> Bool
clean Options
opts then Char
'a' else Char
'_'
in Char
pref forall a. a -> [a] -> [a]
: Identifier -> [Char]
getName Identifier
field forall a. [a] -> [a] -> [a]
++ [Char]
direction forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
getName Identifier
attr
locname :: Options -> Identifier -> String
locname :: Options -> Identifier -> [Char]
locname Options
opts Identifier
v = (if Options -> Bool
clean Options
opts then Char
'l' else Char
'_') forall a. a -> [a] -> [a]
: Identifier -> [Char]
getName Identifier
v
instname, inst'name, fieldname :: Identifier -> String
instname :: Identifier -> [Char]
instname Identifier
v = Identifier -> [Char]
getName Identifier
v forall a. [a] -> [a] -> [a]
++ [Char]
"_val_"
inst'name :: Identifier -> [Char]
inst'name Identifier
v = Identifier -> [Char]
getName Identifier
v forall a. [a] -> [a] -> [a]
++ [Char]
"_inst_"
fieldname :: Identifier -> [Char]
fieldname Identifier
v = Identifier -> [Char]
getName Identifier
vforall a. [a] -> [a] -> [a]
++[Char]
"_"
typeToAGString :: Type -> String
typeToAGString :: Type -> [Char]
typeToAGString Type
tp
= case Type
tp of
Haskell [Char]
t -> [Char]
t
NT Identifier
nt [[Char]]
tps Bool
for -> Bool -> [Char] -> [[Char]] -> [Char]
formatNonterminalToHaskell Bool
for (Identifier -> [Char]
getName Identifier
nt) (forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
s -> [Char]
"{" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"}") [[Char]]
tps)
Type
Self -> forall a. HasCallStack => [Char] -> a
error [Char]
"Self type is not allowed here."
removeDeforested :: Type -> Type
removeDeforested :: Type -> Type
removeDeforested (NT Identifier
nt [[Char]]
args Bool
_) = Identifier -> [[Char]] -> Bool -> Type
NT Identifier
nt [[Char]]
args Bool
False
removeDeforested Type
tp = Type
tp
forceDeforested :: Type -> Type
forceDeforested :: Type -> Type
forceDeforested (NT Identifier
nt [[Char]]
args Bool
_) = Identifier -> [[Char]] -> Bool -> Type
NT Identifier
nt [[Char]]
args Bool
True
forceDeforested Type
tp = Type
tp
typeToHaskellString :: Maybe NontermIdent -> [String] -> Type -> String
typeToHaskellString :: Maybe Identifier -> [[Char]] -> Type -> [Char]
typeToHaskellString Maybe Identifier
mbNt [[Char]]
params Type
tp
= case Type
tp of
Haskell [Char]
t -> forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'@') [Char]
t
NT Identifier
nt [[Char]]
tps Bool
for | Identifier
nt forall a. Eq a => a -> a -> Bool
== Identifier
_SELF -> Bool -> [Char] -> [[Char]] -> [Char]
formatNonterminalToHaskell Bool
for (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"?SELF?" Identifier -> [Char]
getName Maybe Identifier
mbNt) [[Char]]
params
| Bool
otherwise -> Bool -> [Char] -> [[Char]] -> [Char]
formatNonterminalToHaskell Bool
for (Identifier -> [Char]
getName Identifier
nt) [[Char]]
tps
Type
Self -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"?SELF?" Identifier -> [Char]
getName Maybe Identifier
mbNt
formatNonterminalToHaskell :: Bool -> String -> [String] -> String
formatNonterminalToHaskell :: Bool -> [Char] -> [[Char]] -> [Char]
formatNonterminalToHaskell Bool
for [Char]
nt [[Char]]
tps
= [[Char]] -> [Char]
unwords (([Char]
pref forall a. [a] -> [a] -> [a]
++ [Char]
nt) forall a. a -> [a] -> [a]
: [[Char]]
tps)
where pref :: [Char]
pref | Bool
for = [Char]
"T_"
| Bool
otherwise = [Char]
""
ind :: String -> String
ind :: ShowS
ind [Char]
s = forall a. Int -> a -> [a]
replicate Int
3 Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
s
_NOCASE :: Identifier
_NOCASE :: Identifier
_NOCASE = [Char] -> Identifier
identifier [Char]
"nocase"
hasPragma :: PragmaMap -> NontermIdent -> ConstructorIdent -> Identifier -> Bool
hasPragma :: PragmaMap -> Identifier -> Identifier -> Identifier -> Bool
hasPragma PragmaMap
mp Identifier
nt Identifier
con Identifier
nm
= Identifier
nm forall a. Ord a => a -> Set a -> Bool
`Set.member` forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty Identifier
con (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty Identifier
nt PragmaMap
mp)
isNonterminal :: Type -> Bool
isNonterminal :: Type -> Bool
isNonterminal (NT Identifier
_ [[Char]]
_ Bool
_) = Bool
True
isNonterminal Type
_ = Bool
False
isSELFNonterminal :: Type -> Bool
isSELFNonterminal :: Type -> Bool
isSELFNonterminal Type
Self = Bool
True
isSELFNonterminal Type
_ = Bool
False
extractNonterminal :: Type -> NontermIdent
(NT Identifier
n [[Char]]
_ Bool
_) = Identifier
n
extractNonterminal Type
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Must be NT"
nontermArgs :: Type -> [String]
nontermArgs :: Type -> [[Char]]
nontermArgs Type
tp
= case Type
tp of
NT Identifier
_ [[Char]]
args Bool
_ -> [[Char]]
args
Type
_ -> []
deforestedNt :: Identifier -> Maybe Identifier
deforestedNt :: Identifier -> Maybe Identifier
deforestedNt Identifier
nm
| forall a. Int -> [a] -> [a]
take Int
2 (Identifier -> [Char]
getName Identifier
nm) forall a. Eq a => a -> a -> Bool
== [Char]
"T_" = forall a. a -> Maybe a
Just ([Char] -> Pos -> Identifier
Ident (forall a. Int -> [a] -> [a]
drop Int
2 (Identifier -> [Char]
getName Identifier
nm)) (Identifier -> Pos
getPos Identifier
nm))
| Bool
otherwise = forall a. Maybe a
Nothing
data StateCtx
= NoneVis
| OneVis !Int
| ManyVis
deriving (StateCtx -> StateCtx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateCtx -> StateCtx -> Bool
$c/= :: StateCtx -> StateCtx -> Bool
== :: StateCtx -> StateCtx -> Bool
$c== :: StateCtx -> StateCtx -> Bool
Eq, Int -> StateCtx -> ShowS
[StateCtx] -> ShowS
StateCtx -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StateCtx] -> ShowS
$cshowList :: [StateCtx] -> ShowS
show :: StateCtx -> [Char]
$cshow :: StateCtx -> [Char]
showsPrec :: Int -> StateCtx -> ShowS
$cshowsPrec :: Int -> StateCtx -> ShowS
Show, Eq StateCtx
StateCtx -> StateCtx -> Bool
StateCtx -> StateCtx -> Ordering
StateCtx -> StateCtx -> StateCtx
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 :: StateCtx -> StateCtx -> StateCtx
$cmin :: StateCtx -> StateCtx -> StateCtx
max :: StateCtx -> StateCtx -> StateCtx
$cmax :: StateCtx -> StateCtx -> StateCtx
>= :: StateCtx -> StateCtx -> Bool
$c>= :: StateCtx -> StateCtx -> Bool
> :: StateCtx -> StateCtx -> Bool
$c> :: StateCtx -> StateCtx -> Bool
<= :: StateCtx -> StateCtx -> Bool
$c<= :: StateCtx -> StateCtx -> Bool
< :: StateCtx -> StateCtx -> Bool
$c< :: StateCtx -> StateCtx -> Bool
compare :: StateCtx -> StateCtx -> Ordering
$ccompare :: StateCtx -> StateCtx -> Ordering
Ord)
data ChildKind
= ChildSyntax
| ChildAttr
| ChildReplace Type
deriving (ChildKind -> ChildKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChildKind -> ChildKind -> Bool
$c/= :: ChildKind -> ChildKind -> Bool
== :: ChildKind -> ChildKind -> Bool
$c== :: ChildKind -> ChildKind -> Bool
Eq, Int -> ChildKind -> ShowS
[ChildKind] -> ShowS
ChildKind -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ChildKind] -> ShowS
$cshowList :: [ChildKind] -> ShowS
show :: ChildKind -> [Char]
$cshow :: ChildKind -> [Char]
showsPrec :: Int -> ChildKind -> ShowS
$cshowsPrec :: Int -> ChildKind -> ShowS
Show)
closeMap :: Ord a => Map a (Set a) -> Map a (Set a)
closeMap :: forall a. Ord a => Map a (Set a) -> Map a (Set a)
closeMap Map a (Set a)
mp0 = Set a -> Map a (Set a) -> Map a (Set a)
close (forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
mp0) Map a (Set a)
mp0 where
rev :: Map a (Set a)
rev = forall a. Ord a => Map a (Set a) -> Map a (Set a)
revDeps Map a (Set a)
mp0
close :: Set a -> Map a (Set a) -> Map a (Set a)
close Set a
todo Map a (Set a)
mp0' = case forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
todo of
Maybe (a, Set a)
Nothing -> Map a (Set a)
mp0'
Just (a
k, Set a
todo1) -> let find :: a -> Set a
find a
x = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty a
x Map a (Set a)
mp0'
vals0 :: Set a
vals0 = a -> Set a
find a
k
valsL :: [a]
valsL = forall a. Set a -> [a]
Set.toList Set a
vals0
vals1 :: Set a
vals1 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
vals0 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> Set a
find [a]
valsL
in if forall a. Set a -> Int
Set.size Set a
vals0 forall a. Eq a => a -> a -> Bool
== forall a. Set a -> Int
Set.size Set a
vals1
then Set a -> Map a (Set a) -> Map a (Set a)
close Set a
todo1 Map a (Set a)
mp0'
else let mp1 :: Map a (Set a)
mp1 = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
k Set a
vals1 Map a (Set a)
mp0'
refs :: Set a
refs = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty a
k Map a (Set a)
rev
todo2 :: Set a
todo2 = forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
refs Set a
todo1
in Set a -> Map a (Set a) -> Map a (Set a)
close Set a
todo2 Map a (Set a)
mp1
revDeps :: Ord a => Map a (Set a) -> Map a (Set a)
revDeps :: forall a. Ord a => Map a (Set a) -> Map a (Set a)
revDeps Map a (Set a)
mp = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Ord a => Set a -> Set a -> Set a
Set.union [ (a
a,forall a. a -> Set a
Set.singleton a
k) | (a
k,Set a
s) <- forall k a. Map k a -> [(k, a)]
Map.assocs Map a (Set a)
mp, a
a <- forall a. Set a -> [a]
Set.toList Set a
s ]
data HigherOrderInfo = HigherOrderInfo
{ HigherOrderInfo -> Set Identifier
hoNtDeps :: Set NontermIdent
, HigherOrderInfo -> Set Identifier
hoNtRevDeps :: Set NontermIdent
, HigherOrderInfo -> Bool
hoAcyclic :: Bool
}
data VisitKind
= VisitPure Bool
| VisitMonadic
deriving (VisitKind -> VisitKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VisitKind -> VisitKind -> Bool
$c/= :: VisitKind -> VisitKind -> Bool
== :: VisitKind -> VisitKind -> Bool
$c== :: VisitKind -> VisitKind -> Bool
Eq,Eq VisitKind
VisitKind -> VisitKind -> Bool
VisitKind -> VisitKind -> Ordering
VisitKind -> VisitKind -> VisitKind
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 :: VisitKind -> VisitKind -> VisitKind
$cmin :: VisitKind -> VisitKind -> VisitKind
max :: VisitKind -> VisitKind -> VisitKind
$cmax :: VisitKind -> VisitKind -> VisitKind
>= :: VisitKind -> VisitKind -> Bool
$c>= :: VisitKind -> VisitKind -> Bool
> :: VisitKind -> VisitKind -> Bool
$c> :: VisitKind -> VisitKind -> Bool
<= :: VisitKind -> VisitKind -> Bool
$c<= :: VisitKind -> VisitKind -> Bool
< :: VisitKind -> VisitKind -> Bool
$c< :: VisitKind -> VisitKind -> Bool
compare :: VisitKind -> VisitKind -> Ordering
$ccompare :: VisitKind -> VisitKind -> Ordering
Ord)
isLazyKind :: VisitKind -> Bool
isLazyKind :: VisitKind -> Bool
isLazyKind (VisitPure Bool
False) = Bool
True
isLazyKind VisitKind
_ = Bool
False
instance Show VisitKind where
show :: VisitKind -> [Char]
show (VisitPure Bool
False) = [Char]
"Lazy"
show (VisitPure Bool
True) = [Char]
"Ordered"
show VisitKind
VisitMonadic = [Char]
"Monadic"
unionWithMappend :: (Monoid a, Ord k) => Map k a -> Map k a -> Map k a
unionWithMappend :: forall a k. (Monoid a, Ord k) => Map k a -> Map k a -> Map k a
unionWithMappend = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Monoid a => a -> a -> a
mappend
data FormatMode
= FormatDo
| FormatLetDecl
| FormatLetLine
deriving (FormatMode -> FormatMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatMode -> FormatMode -> Bool
$c/= :: FormatMode -> FormatMode -> Bool
== :: FormatMode -> FormatMode -> Bool
$c== :: FormatMode -> FormatMode -> Bool
Eq, Eq FormatMode
FormatMode -> FormatMode -> Bool
FormatMode -> FormatMode -> Ordering
FormatMode -> FormatMode -> FormatMode
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 :: FormatMode -> FormatMode -> FormatMode
$cmin :: FormatMode -> FormatMode -> FormatMode
max :: FormatMode -> FormatMode -> FormatMode
$cmax :: FormatMode -> FormatMode -> FormatMode
>= :: FormatMode -> FormatMode -> Bool
$c>= :: FormatMode -> FormatMode -> Bool
> :: FormatMode -> FormatMode -> Bool
$c> :: FormatMode -> FormatMode -> Bool
<= :: FormatMode -> FormatMode -> Bool
$c<= :: FormatMode -> FormatMode -> Bool
< :: FormatMode -> FormatMode -> Bool
$c< :: FormatMode -> FormatMode -> Bool
compare :: FormatMode -> FormatMode -> Ordering
$ccompare :: FormatMode -> FormatMode -> Ordering
Ord, Int -> FormatMode -> ShowS
[FormatMode] -> ShowS
FormatMode -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FormatMode] -> ShowS
$cshowList :: [FormatMode] -> ShowS
show :: FormatMode -> [Char]
$cshow :: FormatMode -> [Char]
showsPrec :: Int -> FormatMode -> ShowS
$cshowsPrec :: Int -> FormatMode -> ShowS
Show)