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  -- True: deforested nonterminal, False: nonterminal type
          | Self     -- reference to the enclosing nonterminal type
          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 -- Apparently haskell types can contain @ to refer to
                                     -- a type parameter, removing @ makes it backwards compatible
      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 (NT nt _ _) | nt == _SELF = True
isSELFNonterminal :: Type -> Bool
isSELFNonterminal Type
Self                      = Bool
True
isSELFNonterminal Type
_                         = Bool
False

extractNonterminal :: Type -> NontermIdent
extractNonterminal :: Type -> Identifier
extractNonterminal (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        -- This child is defined by syntax
  | ChildAttr          -- This child is defined by an attribute
  | ChildReplace Type  -- This child replaces a child with type 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)

-- Given a map that represents a relation, returns the transitive closure of this relation
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'  -- note: monotonically increasing set
                          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  -- ordered or not
  | 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)