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
(BlockKind -> BlockKind -> Bool)
-> (BlockKind -> BlockKind -> Bool) -> Eq BlockKind
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
Eq BlockKind
-> (BlockKind -> BlockKind -> Ordering)
-> (BlockKind -> BlockKind -> Bool)
-> (BlockKind -> BlockKind -> Bool)
-> (BlockKind -> BlockKind -> Bool)
-> (BlockKind -> BlockKind -> Bool)
-> (BlockKind -> BlockKind -> BlockKind)
-> (BlockKind -> BlockKind -> BlockKind)
-> Ord 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
$cp1Ord :: Eq BlockKind
Ord, Int -> BlockKind -> ShowS
[BlockKind] -> ShowS
BlockKind -> String
(Int -> BlockKind -> ShowS)
-> (BlockKind -> String)
-> ([BlockKind] -> ShowS)
-> Show BlockKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockKind] -> ShowS
$cshowList :: [BlockKind] -> ShowS
show :: BlockKind -> String
$cshow :: BlockKind -> String
showsPrec :: Int -> BlockKind -> ShowS
$cshowsPrec :: Int -> BlockKind -> ShowS
Show)

instance PP Identifier where
  pp :: Identifier -> PP_Doc
pp = String -> PP_Doc
text (String -> PP_Doc)
-> (Identifier -> String) -> Identifier -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> String
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
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
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 -> String
show (List  Type
t )     = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
  show (Tuple [(Identifier, Type)]
ts)     = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> ShowS
forall a. Show a => [a] -> ShowS
showList [ Identifier -> String
forall a. Show a => a -> String
show Identifier
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t | (Identifier
n,Type
t) <- [(Identifier, Type)]
ts ] String
"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (Maybe Type
t )     = String
"Maybe " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t
  show (Either Type
t1 Type
t2) = String
"Either " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t2
  show (Map Type
t1 Type
t2)    = String
"Map " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t2
  show (IntMap Type
t1)    = String
"IntMap " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t1
  show (OrdSet Type
t1)    = String
"Set" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t1
  show ComplexType
IntSet         = String
"IntSet"

instance Show Type where
  show :: Type -> String
show = Maybe Identifier -> [String] -> Type -> String
typeToHaskellString Maybe Identifier
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
(Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool) -> Eq Dependency
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
Eq Dependency
-> (Dependency -> Dependency -> Ordering)
-> (Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Dependency)
-> (Dependency -> Dependency -> Dependency)
-> Ord 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
$cp1Ord :: Eq Dependency
Ord,Int -> Dependency -> ShowS
[Dependency] -> ShowS
Dependency -> String
(Int -> Dependency -> ShowS)
-> (Dependency -> String)
-> ([Dependency] -> ShowS)
-> Show Dependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dependency] -> ShowS
$cshowList :: [Dependency] -> ShowS
show :: Dependency -> String
$cshow :: Dependency -> String
showsPrec :: Int -> Dependency -> ShowS
$cshowsPrec :: Int -> Dependency -> ShowS
Show)
data Occurrence
  = OccAttr Identifier Identifier
  | OccRule Identifier
  deriving (Occurrence -> Occurrence -> Bool
(Occurrence -> Occurrence -> Bool)
-> (Occurrence -> Occurrence -> Bool) -> Eq Occurrence
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
Eq Occurrence
-> (Occurrence -> Occurrence -> Ordering)
-> (Occurrence -> Occurrence -> Bool)
-> (Occurrence -> Occurrence -> Bool)
-> (Occurrence -> Occurrence -> Bool)
-> (Occurrence -> Occurrence -> Bool)
-> (Occurrence -> Occurrence -> Occurrence)
-> (Occurrence -> Occurrence -> Occurrence)
-> Ord 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
$cp1Ord :: Eq Occurrence
Ord,Int -> Occurrence -> ShowS
[Occurrence] -> ShowS
Occurrence -> String
(Int -> Occurrence -> ShowS)
-> (Occurrence -> String)
-> ([Occurrence] -> ShowS)
-> Show Occurrence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Occurrence] -> ShowS
$cshowList :: [Occurrence] -> ShowS
show :: Occurrence -> String
$cshow :: Occurrence -> String
showsPrec :: Int -> Occurrence -> ShowS
$cshowsPrec :: Int -> Occurrence -> ShowS
Show)
data ConstructorType
  = DataConstructor
  | RecordConstructor
  deriving (ConstructorType -> ConstructorType -> Bool
(ConstructorType -> ConstructorType -> Bool)
-> (ConstructorType -> ConstructorType -> Bool)
-> Eq ConstructorType
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
Eq ConstructorType
-> (ConstructorType -> ConstructorType -> Ordering)
-> (ConstructorType -> ConstructorType -> Bool)
-> (ConstructorType -> ConstructorType -> Bool)
-> (ConstructorType -> ConstructorType -> Bool)
-> (ConstructorType -> ConstructorType -> Bool)
-> (ConstructorType -> ConstructorType -> ConstructorType)
-> (ConstructorType -> ConstructorType -> ConstructorType)
-> Ord 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
$cp1Ord :: Eq ConstructorType
Ord,Int -> ConstructorType -> ShowS
[ConstructorType] -> ShowS
ConstructorType -> String
(Int -> ConstructorType -> ShowS)
-> (ConstructorType -> String)
-> ([ConstructorType] -> ShowS)
-> Show ConstructorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorType] -> ShowS
$cshowList :: [ConstructorType] -> ShowS
show :: ConstructorType -> String
$cshow :: ConstructorType -> String
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 = String -> Identifier
identifier String
""
_LHS :: Identifier
_LHS   = String -> Identifier
identifier String
"lhs"
_SELF :: Identifier
_SELF  = String -> Identifier
identifier String
"SELF"
_LOC :: Identifier
_LOC   = String -> Identifier
identifier String
"loc"
_INST :: Identifier
_INST  = String -> Identifier
identifier String
"inst"
_INST' :: Identifier
_INST' = String -> Identifier
identifier String
"inst'"
_FIELD :: Identifier
_FIELD = String -> Identifier
identifier String
"field"
_FIRST :: Identifier
_FIRST = String -> Identifier
identifier String
"first__"
_LAST :: Identifier
_LAST  = String -> Identifier
identifier String
"last__"

idLateBindingAttr :: Identifier
idLateBindingAttr :: Identifier
idLateBindingAttr = String -> Identifier
identifier String
"lateSemDict"

lateBindingTypeNm :: String -> String
lateBindingTypeNm :: ShowS
lateBindingTypeNm String
modNm = String
"Late_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
modNm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_"

lateBindingFieldNm :: String -> String
lateBindingFieldNm :: ShowS
lateBindingFieldNm String
modNm = String
"late_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
modNm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_"

lateBindingType :: String -> Type
lateBindingType :: String -> Type
lateBindingType String
modNm = String -> Type
Haskell (ShowS
lateBindingTypeNm String
modNm)

lateSemNtLabel :: NontermIdent -> String
lateSemNtLabel :: Identifier -> String
lateSemNtLabel Identifier
nt = String
"mk_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
nt

lateSemConLabel :: NontermIdent -> ConstructorIdent -> String
lateSemConLabel :: Identifier -> Identifier -> String
lateSemConLabel Identifier
nt Identifier
con = String
"mk_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
nt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
con

sdtype :: NontermIdent -> String
sdtype :: Identifier -> String
sdtype Identifier
nt = String
"T_"String -> ShowS
forall a. [a] -> [a] -> [a]
++Identifier -> String
getName Identifier
nt

mkNtType :: Identifier -> [String] -> Type
mkNtType :: Identifier -> [String] -> Type
mkNtType Identifier
nt [String]
args
  | Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
2 (Identifier -> String
getName Identifier
nt) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"T_" = let nt' :: Identifier
nt' = String -> Pos -> Identifier
Ident (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 (Identifier -> String
getName Identifier
nt)) (Identifier -> Pos
getPos Identifier
nt)
                                  in  Identifier -> [String] -> Bool -> Type
NT Identifier
nt' [String]
args Bool
True
  | Bool
otherwise                   = Identifier -> [String] -> Bool -> Type
NT Identifier
nt [String]
args Bool
False

cataname ::  String -> Identifier -> String
cataname :: String -> Identifier -> String
cataname String
pre Identifier
name = String
preString -> ShowS
forall a. [a] -> [a] -> [a]
++Identifier -> String
getName Identifier
name

conname :: Bool -> NontermIdent -> ConstructorIdent -> String
conname :: Bool -> Identifier -> Identifier -> String
conname Bool
ren Identifier
nt Identifier
con | Bool
ren =  ShowS
capitalize (Identifier -> String
getName Identifier
nt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
con
                   | Bool
otherwise = Identifier -> String
getName Identifier
con

capitalize        :: String -> String
capitalize :: ShowS
capitalize []     = []
capitalize (Char
c:String
cs) = Char -> Char
toUpper Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs

semname  ::  String -> NontermIdent -> ConstructorIdent -> String
semname :: String -> Identifier -> Identifier -> String
semname String
pre Identifier
nt Identifier
con =  String
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Identifier -> String
getName Identifier
nt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
con)

recordFieldname :: NontermIdent -> ConstructorIdent -> Identifier -> String
recordFieldname :: Identifier -> Identifier -> Identifier -> String
recordFieldname Identifier
nt Identifier
con Identifier
nm = Identifier -> String
getName Identifier
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
nt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
con

lhsname :: Options -> Bool -> Identifier -> String
lhsname :: Options -> Bool -> Identifier -> String
lhsname Options
opts Bool
isIn = Options -> Bool -> Identifier -> Identifier -> String
attrname Options
opts Bool
isIn Identifier
_LHS

attrname :: Options -> Bool -> Identifier -> Identifier -> String
attrname :: Options -> Bool -> Identifier -> Identifier -> String
attrname Options
opts Bool
isIn Identifier
field Identifier
attr
  | Identifier
field Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
_LOC   = Options -> Identifier -> String
locname Options
opts Identifier
attr
  | Identifier
field Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
_INST  = Identifier -> String
instname Identifier
attr
  | Identifier
field Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
_INST' = Identifier -> String
inst'name Identifier
attr
  | Identifier
field Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
_FIELD = Identifier -> String
fieldname Identifier
attr
  | Bool
otherwise       = let direction :: String
direction | Bool
isIn      = String
"I"
                                    | Bool
otherwise = String
"O"
                          pref :: Char
pref = if Options -> Bool
clean Options
opts then Char
'a' else Char
'_'
                      in  Char
pref Char -> ShowS
forall a. a -> [a] -> [a]
: Identifier -> String
getName Identifier
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
direction String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
attr

locname :: Options -> Identifier -> String
locname :: Options -> Identifier -> String
locname Options
opts Identifier
v   = (if Options -> Bool
clean Options
opts then Char
'l' else Char
'_') Char -> ShowS
forall a. a -> [a] -> [a]
: Identifier -> String
getName Identifier
v

instname, inst'name, fieldname :: Identifier -> String
instname :: Identifier -> String
instname Identifier
v  = Identifier -> String
getName Identifier
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_val_"
inst'name :: Identifier -> String
inst'name Identifier
v = Identifier -> String
getName Identifier
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_inst_"
fieldname :: Identifier -> String
fieldname Identifier
v =  Identifier -> String
getName Identifier
vString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"_"

typeToAGString :: Type -> String
typeToAGString :: Type -> String
typeToAGString Type
tp
  = case Type
tp of
      Haskell String
t     -> String
t
      NT Identifier
nt [String]
tps Bool
for -> Bool -> String -> [String] -> String
formatNonterminalToHaskell Bool
for (Identifier -> String
getName Identifier
nt) (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}") [String]
tps)
      Type
Self          -> ShowS
forall a. HasCallStack => String -> a
error String
"Self type is not allowed here."

removeDeforested :: Type -> Type
removeDeforested :: Type -> Type
removeDeforested (NT Identifier
nt [String]
args Bool
_) = Identifier -> [String] -> Bool -> Type
NT Identifier
nt [String]
args Bool
False
removeDeforested Type
tp             = Type
tp

forceDeforested :: Type -> Type
forceDeforested :: Type -> Type
forceDeforested (NT Identifier
nt [String]
args Bool
_) = Identifier -> [String] -> Bool -> Type
NT Identifier
nt [String]
args Bool
True
forceDeforested Type
tp             = Type
tp

typeToHaskellString :: Maybe NontermIdent -> [String] -> Type -> String
typeToHaskellString :: Maybe Identifier -> [String] -> Type -> String
typeToHaskellString Maybe Identifier
mbNt [String]
params Type
tp
  = case Type
tp of
      Haskell String
t -> (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@') String
t -- Apparently haskell types can contain @ to refer to

                                     -- a type parameter, removing @ makes it backwards compatible

      NT Identifier
nt [String]
tps Bool
for | Identifier
nt Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
_SELF -> Bool -> String -> [String] -> String
formatNonterminalToHaskell Bool
for (String -> (Identifier -> String) -> Maybe Identifier -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"?SELF?" Identifier -> String
getName Maybe Identifier
mbNt) [String]
params
                    | Bool
otherwise   -> Bool -> String -> [String] -> String
formatNonterminalToHaskell Bool
for (Identifier -> String
getName Identifier
nt) [String]
tps
      Type
Self -> String -> (Identifier -> String) -> Maybe Identifier -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"?SELF?" Identifier -> String
getName Maybe Identifier
mbNt

formatNonterminalToHaskell :: Bool -> String -> [String] -> String
formatNonterminalToHaskell :: Bool -> String -> [String] -> String
formatNonterminalToHaskell Bool
for String
nt [String]
tps
  = [String] -> String
unwords ((String
pref String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nt) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
tps)
  where pref :: String
pref | Bool
for       = String
"T_"
             | Bool
otherwise = String
""

ind :: String -> String
ind :: ShowS
ind String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
3 Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

_NOCASE :: Identifier
_NOCASE :: Identifier
_NOCASE = String -> Identifier
identifier String
"nocase"

hasPragma :: PragmaMap -> NontermIdent -> ConstructorIdent -> Identifier -> Bool
hasPragma :: PragmaMap -> Identifier -> Identifier -> Identifier -> Bool
hasPragma PragmaMap
mp Identifier
nt Identifier
con Identifier
nm
  = Identifier
nm Identifier -> Set Identifier -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Identifier
-> Identifier -> Map Identifier (Set Identifier) -> Set Identifier
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set Identifier
forall a. Set a
Set.empty Identifier
con (Map Identifier (Set Identifier)
-> Identifier -> PragmaMap -> Map Identifier (Set Identifier)
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map Identifier (Set Identifier)
forall k a. Map k a
Map.empty Identifier
nt PragmaMap
mp)

isNonterminal :: Type -> Bool
isNonterminal :: Type -> Bool
isNonterminal (NT Identifier
_ [String]
_ 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 [String]
_ Bool
_) = Identifier
n
extractNonterminal Type
_          = String -> Identifier
forall a. HasCallStack => String -> a
error String
"Must be NT"

nontermArgs :: Type -> [String]
nontermArgs :: Type -> [String]
nontermArgs Type
tp
  = case Type
tp of
      NT Identifier
_ [String]
args Bool
_ -> [String]
args
      Type
_           -> []

deforestedNt :: Identifier -> Maybe Identifier
deforestedNt :: Identifier -> Maybe Identifier
deforestedNt Identifier
nm
  | Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
2 (Identifier -> String
getName Identifier
nm) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"T_" = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (String -> Pos -> Identifier
Ident (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 (Identifier -> String
getName Identifier
nm)) (Identifier -> Pos
getPos Identifier
nm))
  | Bool
otherwise = Maybe Identifier
forall a. Maybe a
Nothing

data StateCtx
  = NoneVis
  | OneVis !Int
  | ManyVis
  deriving (StateCtx -> StateCtx -> Bool
(StateCtx -> StateCtx -> Bool)
-> (StateCtx -> StateCtx -> Bool) -> Eq StateCtx
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 -> String
(Int -> StateCtx -> ShowS)
-> (StateCtx -> String) -> ([StateCtx] -> ShowS) -> Show StateCtx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateCtx] -> ShowS
$cshowList :: [StateCtx] -> ShowS
show :: StateCtx -> String
$cshow :: StateCtx -> String
showsPrec :: Int -> StateCtx -> ShowS
$cshowsPrec :: Int -> StateCtx -> ShowS
Show, Eq StateCtx
Eq StateCtx
-> (StateCtx -> StateCtx -> Ordering)
-> (StateCtx -> StateCtx -> Bool)
-> (StateCtx -> StateCtx -> Bool)
-> (StateCtx -> StateCtx -> Bool)
-> (StateCtx -> StateCtx -> Bool)
-> (StateCtx -> StateCtx -> StateCtx)
-> (StateCtx -> StateCtx -> StateCtx)
-> Ord 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
$cp1Ord :: Eq StateCtx
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
(ChildKind -> ChildKind -> Bool)
-> (ChildKind -> ChildKind -> Bool) -> Eq ChildKind
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 -> String
(Int -> ChildKind -> ShowS)
-> (ChildKind -> String)
-> ([ChildKind] -> ShowS)
-> Show ChildKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChildKind] -> ShowS
$cshowList :: [ChildKind] -> ShowS
show :: ChildKind -> String
$cshow :: ChildKind -> String
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 :: 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 (Map a (Set a) -> Set a
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 = Map a (Set a) -> Map a (Set a)
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 Set a -> Maybe (a, Set a)
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 = Set a -> a -> Map a (Set a) -> Set a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set a
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  = Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
vals0
                           vals1 :: Set a
vals1  = (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
vals0 ([Set a] -> Set a) -> [Set a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Set a) -> [a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Set a
find [a]
valsL
                       in if Set a -> Int
forall a. Set a -> Int
Set.size Set a
vals0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> Int
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   = a -> Set a -> Map a (Set a) -> Map a (Set a)
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  = Set a -> a -> Map a (Set a) -> Set a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set a
forall a. Set a
Set.empty a
k Map a (Set a)
rev
                                   todo2 :: Set a
todo2 = Set a -> Set a -> Set a
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 :: Map a (Set a) -> Map a (Set a)
revDeps Map a (Set a)
mp = (Set a -> Set a -> Set a) -> [(a, Set a)] -> Map a (Set a)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union [ (a
a,a -> Set a
forall a. a -> Set a
Set.singleton a
k) | (a
k,Set a
s) <- Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map a (Set a)
mp, a
a <- Set 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
(VisitKind -> VisitKind -> Bool)
-> (VisitKind -> VisitKind -> Bool) -> Eq VisitKind
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
Eq VisitKind
-> (VisitKind -> VisitKind -> Ordering)
-> (VisitKind -> VisitKind -> Bool)
-> (VisitKind -> VisitKind -> Bool)
-> (VisitKind -> VisitKind -> Bool)
-> (VisitKind -> VisitKind -> Bool)
-> (VisitKind -> VisitKind -> VisitKind)
-> (VisitKind -> VisitKind -> VisitKind)
-> Ord 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
$cp1Ord :: Eq VisitKind
Ord)

isLazyKind :: VisitKind -> Bool
isLazyKind :: VisitKind -> Bool
isLazyKind (VisitPure Bool
False) = Bool
True
isLazyKind VisitKind
_                 = Bool
False

instance Show VisitKind where
  show :: VisitKind -> String
show (VisitPure Bool
False) = String
"Lazy"
  show (VisitPure Bool
True)  = String
"Ordered"
  show VisitKind
VisitMonadic      = String
"Monadic"

unionWithMappend :: (Monoid a, Ord k) => Map k a -> Map k a -> Map k a
unionWithMappend :: Map k a -> Map k a -> Map k a
unionWithMappend = (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend


data FormatMode
  = FormatDo
  | FormatLetDecl
  | FormatLetLine
  deriving (FormatMode -> FormatMode -> Bool
(FormatMode -> FormatMode -> Bool)
-> (FormatMode -> FormatMode -> Bool) -> Eq FormatMode
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
Eq FormatMode
-> (FormatMode -> FormatMode -> Ordering)
-> (FormatMode -> FormatMode -> Bool)
-> (FormatMode -> FormatMode -> Bool)
-> (FormatMode -> FormatMode -> Bool)
-> (FormatMode -> FormatMode -> Bool)
-> (FormatMode -> FormatMode -> FormatMode)
-> (FormatMode -> FormatMode -> FormatMode)
-> Ord 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
$cp1Ord :: Eq FormatMode
Ord, Int -> FormatMode -> ShowS
[FormatMode] -> ShowS
FormatMode -> String
(Int -> FormatMode -> ShowS)
-> (FormatMode -> String)
-> ([FormatMode] -> ShowS)
-> Show FormatMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatMode] -> ShowS
$cshowList :: [FormatMode] -> ShowS
show :: FormatMode -> String
$cshow :: FormatMode -> String
showsPrec :: Int -> FormatMode -> ShowS
$cshowsPrec :: Int -> FormatMode -> ShowS
Show)