{-# LANGUAGE OverloadedStrings #-}

-- | Utilies for Haskell state initialitation.

module BNFC.Backend.Haskell.Utilities.InitState
  ( getTokens
  , processFunctions
  , processParserRules
  , processRules
  , sortTokens
  )
  where

import BNFC.Prelude

import           Data.List (sortBy)
import qualified Data.Map as Map

import BNFC.Backend.Haskell.Utilities.ReservedWords
import BNFC.Backend.Haskell.Utilities.Utils

import BNFC.CF
import BNFC.Types.Position

-- | Process AST rules to generate Abstract Syntax and Printer.

processRules :: ASTRulesAP
             -> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
processRules :: ASTRulesAP -> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
processRules ASTRulesAP
rules = [(Type, [(Label, ([Type], (Integer, ARHS)))])]
sorted
  where

    -- list sorted according to order categories are declaired in the .cf file.
    sorted :: [(Type, [(Label, ([Type], (Integer, ARHS)))])]
sorted = (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
-> (Type, [(Label, ([Type], (Integer, ARHS)))])
removePosition ((Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
 -> (Type, [(Label, ([Type], (Integer, ARHS)))]))
-> ((Position,
     (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
    -> (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
-> (Position,
    (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
-> (Type, [(Label, ([Type], (Integer, ARHS)))])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position,
 (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
-> (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
forall a b. (a, b) -> b
snd
             ((Position,
  (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
 -> (Type, [(Label, ([Type], (Integer, ARHS)))]))
-> [(Position,
     (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))]
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             ((Position,
  (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
 -> (Position,
     (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
 -> Ordering)
-> [(Position,
     (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))]
-> [(Position,
     (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position -> Position -> Ordering)
-> ((Position,
     (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
    -> Position)
-> (Position,
    (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
-> (Position,
    (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Position,
 (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
-> Position
forall a b. (a, b) -> a
fst) [(Position,
  (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))]
withMinPos

    -- remove position from ARHS.
    removePosition :: (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
      -> (Type, [(Label, ([Type], (Integer, ARHS)))])
    removePosition :: (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
-> (Type, [(Label, ([Type], (Integer, ARHS)))])
removePosition (Type
t,[(Label, ([Type], (Integer, WithPosition ARHS)))]
l) =
      (Type
t, ( \(Label
la,([Type]
ts,(Integer, WithPosition ARHS)
tup)) -> (Label
la,([Type]
ts, (\(Integer
i, WithPosition Position
_ ARHS
arhs) -> (Integer
i,ARHS
arhs)) (Integer, WithPosition ARHS)
tup )) ) ((Label, ([Type], (Integer, WithPosition ARHS)))
 -> (Label, ([Type], (Integer, ARHS))))
-> [(Label, ([Type], (Integer, WithPosition ARHS)))]
-> [(Label, ([Type], (Integer, ARHS)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Label, ([Type], (Integer, WithPosition ARHS)))]
l)

    -- associate first rhs position to each category (type).
    withMinPos ::
      [(Position, (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))]
    withMinPos :: [(Position,
  (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))]
withMinPos = [Position]
-> [(Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])]
-> [(Position,
     (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
-> Position
minRhsPos ((Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
 -> Position)
-> [(Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])]
-> [Position]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])]
rulesList) [(Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])]
rulesList

     -- get position of first rhs associated to a rule.
    minRhsPos :: (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
                  -> Position
    minRhsPos :: (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])
-> Position
minRhsPos (Type
_,[(Label, ([Type], (Integer, WithPosition ARHS)))]
l) = [Position] -> Position
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Position] -> Position) -> [Position] -> Position
forall a b. (a -> b) -> a -> b
$ WithPosition ARHS -> Position
forall a. WithPosition a -> Position
wpPos (WithPosition ARHS -> Position)
-> [WithPosition ARHS] -> [Position]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Label, ([Type], (Integer, WithPosition ARHS)))
 -> WithPosition ARHS)
-> [(Label, ([Type], (Integer, WithPosition ARHS)))]
-> [WithPosition ARHS]
forall a b. (a -> b) -> [a] -> [b]
map ( \(Label
_,([Type]
_,(Integer, WithPosition ARHS)
t)) -> (Integer, WithPosition ARHS) -> WithPosition ARHS
forall a b. (a, b) -> b
snd (Integer, WithPosition ARHS)
t ) [(Label, ([Type], (Integer, WithPosition ARHS)))]
l

    -- AST rules list.
    rulesList ::
      [(Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])]
    rulesList :: [(Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])]
rulesList = (\(Type
t,Map Label ([Type], (Integer, WithPosition ARHS))
m) -> (Type
t, Map Label ([Type], (Integer, WithPosition ARHS))
-> [(Label, ([Type], (Integer, WithPosition ARHS)))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Label ([Type], (Integer, WithPosition ARHS))
m)) ((Type, Map Label ([Type], (Integer, WithPosition ARHS)))
 -> (Type, [(Label, ([Type], (Integer, WithPosition ARHS)))]))
-> [(Type, Map Label ([Type], (Integer, WithPosition ARHS)))]
-> [(Type, [(Label, ([Type], (Integer, WithPosition ARHS)))])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTRulesAP
-> [(Type, Map Label ([Type], (Integer, WithPosition ARHS)))]
forall k a. Map k a -> [(k, a)]
Map.toList ASTRulesAP
rules

-- | Sort tokens (token pragma) according to their
-- definition order in the .cf file.

sortTokens :: TokenDefs -> [(CatName,TokenDef)]
sortTokens :: TokenDefs -> [(CatName, TokenDef)]
sortTokens TokenDefs
defs = [(CatName, TokenDef)]
sorted
  where
    sorted :: [(CatName, TokenDef)]
    sorted :: [(CatName, TokenDef)]
sorted = (CatName, WithPosition TokenDef) -> (CatName, TokenDef)
removePosition ((CatName, WithPosition TokenDef) -> (CatName, TokenDef))
-> ((Position, (CatName, WithPosition TokenDef))
    -> (CatName, WithPosition TokenDef))
-> (Position, (CatName, WithPosition TokenDef))
-> (CatName, TokenDef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, (CatName, WithPosition TokenDef))
-> (CatName, WithPosition TokenDef)
forall a b. (a, b) -> b
snd ((Position, (CatName, WithPosition TokenDef))
 -> (CatName, TokenDef))
-> [(Position, (CatName, WithPosition TokenDef))]
-> [(CatName, TokenDef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Position, (CatName, WithPosition TokenDef))
 -> (Position, (CatName, WithPosition TokenDef)) -> Ordering)
-> [(Position, (CatName, WithPosition TokenDef))]
-> [(Position, (CatName, WithPosition TokenDef))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position -> Position -> Ordering)
-> ((Position, (CatName, WithPosition TokenDef)) -> Position)
-> (Position, (CatName, WithPosition TokenDef))
-> (Position, (CatName, WithPosition TokenDef))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Position, (CatName, WithPosition TokenDef)) -> Position
forall a b. (a, b) -> a
fst) [(Position, (CatName, WithPosition TokenDef))]
withPos
    removePosition :: (CatName, WithPosition TokenDef) -> (CatName, TokenDef)
    removePosition :: (CatName, WithPosition TokenDef) -> (CatName, TokenDef)
removePosition (CatName
c,WithPosition TokenDef
pt) = (CatName
c, WithPosition TokenDef -> TokenDef
forall a. WithPosition a -> a
wpThing WithPosition TokenDef
pt)
    withPos :: [(Position, (CatName, WithPosition TokenDef))]
    withPos :: [(Position, (CatName, WithPosition TokenDef))]
withPos = [Position]
-> [(CatName, WithPosition TokenDef)]
-> [(Position, (CatName, WithPosition TokenDef))]
forall a b. [a] -> [b] -> [(a, b)]
zip ( WithPosition TokenDef -> Position
forall a. WithPosition a -> Position
wpPos (WithPosition TokenDef -> Position)
-> ((CatName, WithPosition TokenDef) -> WithPosition TokenDef)
-> (CatName, WithPosition TokenDef)
-> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CatName, WithPosition TokenDef) -> WithPosition TokenDef
forall a b. (a, b) -> b
snd ((CatName, WithPosition TokenDef) -> Position)
-> [(CatName, WithPosition TokenDef)] -> [Position]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenDefs -> [(CatName, WithPosition TokenDef)]
forall k a. Map k a -> [(k, a)]
Map.toList TokenDefs
defs) (TokenDefs -> [(CatName, WithPosition TokenDef)]
forall k a. Map k a -> [(k, a)]
Map.toList TokenDefs
defs)

-- | Get grammar tokens for lexer specification generation.

getTokens :: LBNF -> [Token]
getTokens :: LBNF -> [Token]
getTokens LBNF
lbnf = [Token]
builtins [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
userDefined
  where
    hasIdent :: Bool
    hasIdent :: Bool
hasIdent = TokenDefs -> Bool
hasIdentifier (TokenDefs -> Bool) -> TokenDefs -> Bool
forall a b. (a -> b) -> a -> b
$ LBNF -> TokenDefs
_lbnfTokenDefs LBNF
lbnf

    builtins :: [Token]
    builtins :: [Token]
builtins =
      if Bool
hasIdent
      then Token
Identifier Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (BuiltinCat -> Token
Builtin (BuiltinCat -> Token) -> [BuiltinCat] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BuiltinCat]
usedBuiltins)
      else  BuiltinCat -> Token
Builtin (BuiltinCat -> Token) -> [BuiltinCat] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BuiltinCat]
usedBuiltins

    userDefined :: [Token]
    userDefined :: [Token]
userDefined =
      CatName -> Token
UserDefined (CatName -> Token)
-> ((CatName, TokenDef) -> CatName) -> (CatName, TokenDef) -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CatName, TokenDef) -> CatName
forall a b. (a, b) -> a
fst
      ((CatName, TokenDef) -> Token) -> [(CatName, TokenDef)] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      TokenDefs -> [(CatName, TokenDef)]
sortTokens (
        if Bool
hasIdent
        then CatName -> TokenDefs -> TokenDefs
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Char
'I'Char -> [Char] -> CatName
forall a. a -> [a] -> NonEmpty a
:|[Char]
"dent") (LBNF -> TokenDefs
_lbnfTokenDefs LBNF
lbnf)
        else LBNF -> TokenDefs
_lbnfTokenDefs LBNF
lbnf )

    usedBuiltins :: [BuiltinCat]
    usedBuiltins :: [BuiltinCat]
usedBuiltins = Map BuiltinCat (List1 Position) -> [BuiltinCat]
forall k a. Map k a -> [k]
Map.keys (Map BuiltinCat (List1 Position) -> [BuiltinCat])
-> Map BuiltinCat (List1 Position) -> [BuiltinCat]
forall a b. (a -> b) -> a -> b
$ LBNF -> Map BuiltinCat (List1 Position)
_lbnfParserBuiltins LBNF
lbnf

-- | Sort functions (define pragma) and avoid reserved words.

processFunctions :: Functions -> [(LabelName,Function)]
processFunctions :: Functions -> [(CatName, Function)]
processFunctions Functions
funs = (CatName, Function) -> (CatName, Function)
checkFunction ((CatName, Function) -> (CatName, Function))
-> [(CatName, Function)] -> [(CatName, Function)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Functions -> [(CatName, Function)]
sortFunctions Functions
funs

-- | Sort functions (define pragma) according to their
-- definition order in the .cf file.

sortFunctions :: Functions -> [(LabelName,Function)]
sortFunctions :: Functions -> [(CatName, Function)]
sortFunctions Functions
funs = [(CatName, Function)]
sorted
  where
    sorted :: [(LabelName, Function)]
    sorted :: [(CatName, Function)]
sorted = (CatName, WithPosition Function) -> (CatName, Function)
removePosition ((CatName, WithPosition Function) -> (CatName, Function))
-> ((Position, (CatName, WithPosition Function))
    -> (CatName, WithPosition Function))
-> (Position, (CatName, WithPosition Function))
-> (CatName, Function)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, (CatName, WithPosition Function))
-> (CatName, WithPosition Function)
forall a b. (a, b) -> b
snd ((Position, (CatName, WithPosition Function))
 -> (CatName, Function))
-> [(Position, (CatName, WithPosition Function))]
-> [(CatName, Function)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Position, (CatName, WithPosition Function))
 -> (Position, (CatName, WithPosition Function)) -> Ordering)
-> [(Position, (CatName, WithPosition Function))]
-> [(Position, (CatName, WithPosition Function))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position -> Position -> Ordering)
-> ((Position, (CatName, WithPosition Function)) -> Position)
-> (Position, (CatName, WithPosition Function))
-> (Position, (CatName, WithPosition Function))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Position, (CatName, WithPosition Function)) -> Position
forall a b. (a, b) -> a
fst) [(Position, (CatName, WithPosition Function))]
withPos
    removePosition :: (LabelName, WithPosition Function)
                      -> (LabelName, Function)
    removePosition :: (CatName, WithPosition Function) -> (CatName, Function)
removePosition (CatName
c,WithPosition Function
pt) = (CatName
c, WithPosition Function -> Function
forall a. WithPosition a -> a
wpThing WithPosition Function
pt)
    withPos :: [(Position, (LabelName, WithPosition Function))]
    withPos :: [(Position, (CatName, WithPosition Function))]
withPos = [Position]
-> [(CatName, WithPosition Function)]
-> [(Position, (CatName, WithPosition Function))]
forall a b. [a] -> [b] -> [(a, b)]
zip ( WithPosition Function -> Position
forall a. WithPosition a -> Position
wpPos (WithPosition Function -> Position)
-> ((CatName, WithPosition Function) -> WithPosition Function)
-> (CatName, WithPosition Function)
-> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CatName, WithPosition Function) -> WithPosition Function
forall a b. (a, b) -> b
snd ((CatName, WithPosition Function) -> Position)
-> [(CatName, WithPosition Function)] -> [Position]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Functions -> [(CatName, WithPosition Function)]
forall k a. Map k a -> [(k, a)]
Map.toList Functions
funs) (Functions -> [(CatName, WithPosition Function)]
forall k a. Map k a -> [(k, a)]
Map.toList Functions
funs)

-- | Sort parser rules and avoid reserved words.

processParserRules :: ParserRules -> [(Cat, Map RHS RuleLabel)]
processParserRules :: ParserRules -> [(Cat, Map RHS RuleLabel)]
processParserRules ParserRules
rules =
  (\(Cat
c,Map RHS RuleLabel
rhs) -> (Cat
c, (RuleLabel -> RuleLabel) -> Map RHS RuleLabel -> Map RHS RuleLabel
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map RuleLabel -> RuleLabel
checkRuleLabel Map RHS RuleLabel
rhs)) ((Cat, Map RHS RuleLabel) -> (Cat, Map RHS RuleLabel))
-> [(Cat, Map RHS RuleLabel)] -> [(Cat, Map RHS RuleLabel)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserRules -> [(Cat, Map RHS RuleLabel)]
sortParserRules ParserRules
rules

-- | Sort parser rules according to their
-- definition order in the .cf file.

sortParserRules :: ParserRules -> [(Cat, Map RHS RuleLabel)]
sortParserRules :: ParserRules -> [(Cat, Map RHS RuleLabel)]
sortParserRules ParserRules
rules = [(Cat, Map RHS RuleLabel)]
sorted
  where
    sorted :: [(Cat, Map RHS RuleLabel)]
    sorted :: [(Cat, Map RHS RuleLabel)]
sorted =
      (Cat, Map RHS (WithPosition RuleLabel)) -> (Cat, Map RHS RuleLabel)
removePosition ((Cat, Map RHS (WithPosition RuleLabel))
 -> (Cat, Map RHS RuleLabel))
-> ((Position, (Cat, Map RHS (WithPosition RuleLabel)))
    -> (Cat, Map RHS (WithPosition RuleLabel)))
-> (Position, (Cat, Map RHS (WithPosition RuleLabel)))
-> (Cat, Map RHS RuleLabel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, (Cat, Map RHS (WithPosition RuleLabel)))
-> (Cat, Map RHS (WithPosition RuleLabel))
forall a b. (a, b) -> b
snd
      ((Position, (Cat, Map RHS (WithPosition RuleLabel)))
 -> (Cat, Map RHS RuleLabel))
-> [(Position, (Cat, Map RHS (WithPosition RuleLabel)))]
-> [(Cat, Map RHS RuleLabel)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ((Position, (Cat, Map RHS (WithPosition RuleLabel)))
 -> (Position, (Cat, Map RHS (WithPosition RuleLabel))) -> Ordering)
-> [(Position, (Cat, Map RHS (WithPosition RuleLabel)))]
-> [(Position, (Cat, Map RHS (WithPosition RuleLabel)))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position -> Position -> Ordering)
-> ((Position, (Cat, Map RHS (WithPosition RuleLabel)))
    -> Position)
-> (Position, (Cat, Map RHS (WithPosition RuleLabel)))
-> (Position, (Cat, Map RHS (WithPosition RuleLabel)))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Position, (Cat, Map RHS (WithPosition RuleLabel))) -> Position
forall a b. (a, b) -> a
fst) [(Position, (Cat, Map RHS (WithPosition RuleLabel)))]
withMinPos

    removePosition :: (Cat, Map RHS (WithPosition RuleLabel))
                   -> (Cat, Map RHS RuleLabel)
    removePosition :: (Cat, Map RHS (WithPosition RuleLabel)) -> (Cat, Map RHS RuleLabel)
removePosition (Cat
c,Map RHS (WithPosition RuleLabel)
m) = (Cat
c, (WithPosition RuleLabel -> RuleLabel)
-> Map RHS (WithPosition RuleLabel) -> Map RHS RuleLabel
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map WithPosition RuleLabel -> RuleLabel
forall a. WithPosition a -> a
wpThing Map RHS (WithPosition RuleLabel)
m)

    getMinPos :: (Cat, Map RHS (WithPosition RuleLabel)) -> Position
    getMinPos :: (Cat, Map RHS (WithPosition RuleLabel)) -> Position
getMinPos (Cat
_,Map RHS (WithPosition RuleLabel)
m) = [Position] -> Position
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Position] -> Position) -> [Position] -> Position
forall a b. (a -> b) -> a -> b
$ (WithPosition RuleLabel -> Position)
-> [WithPosition RuleLabel] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map WithPosition RuleLabel -> Position
forall a. WithPosition a -> Position
wpPos (Map RHS (WithPosition RuleLabel) -> [WithPosition RuleLabel]
forall k a. Map k a -> [a]
Map.elems Map RHS (WithPosition RuleLabel)
m)

    withMinPos :: [(Position, (Cat, Map RHS (WithPosition RuleLabel)))]
    withMinPos :: [(Position, (Cat, Map RHS (WithPosition RuleLabel)))]
withMinPos = [Position]
-> [(Cat, Map RHS (WithPosition RuleLabel))]
-> [(Position, (Cat, Map RHS (WithPosition RuleLabel)))]
forall a b. [a] -> [b] -> [(a, b)]
zip ( (Cat, Map RHS (WithPosition RuleLabel)) -> Position
getMinPos ((Cat, Map RHS (WithPosition RuleLabel)) -> Position)
-> [(Cat, Map RHS (WithPosition RuleLabel))] -> [Position]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserRules -> [(Cat, Map RHS (WithPosition RuleLabel))]
forall k a. Map k a -> [(k, a)]
Map.toList ParserRules
rules) (ParserRules -> [(Cat, Map RHS (WithPosition RuleLabel))]
forall k a. Map k a -> [(k, a)]
Map.toList ParserRules
rules)

-- | Avoid reserved words in functions from @define@ pragmas.

checkFunction :: (LabelName, Function)
              -> (LabelName, Function)
checkFunction :: (CatName, Function) -> (CatName, Function)
checkFunction (CatName
l,Function
f) = (CatName -> CatName
avoidReservedWords1 CatName
l, Function -> Function
checkFun Function
f)

checkFun :: Function -> Function
checkFun :: Function -> Function
checkFun f :: Function
f@Function {funPars :: Function -> [Parameter]
funPars=[Parameter]
params, funBody :: Function -> Exp
funBody=Exp
body} =
  Function
f {funPars :: [Parameter]
funPars = [Parameter] -> [Parameter]
checkPars [Parameter]
params, funBody :: Exp
funBody = Exp -> Exp
checkBody Exp
body}

checkPars :: [Parameter] -> [Parameter]
checkPars :: [Parameter] -> [Parameter]
checkPars [Parameter]
pars = Parameter -> Parameter
checkPar (Parameter -> Parameter) -> [Parameter] -> [Parameter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parameter]
pars

checkPar :: Parameter -> Parameter
checkPar :: Parameter -> Parameter
checkPar Parameter
p = Parameter
p { paramName :: CatName
paramName = CatName -> CatName
avoidReservedWords1 (CatName -> CatName) -> CatName -> CatName
forall a b. (a -> b) -> a -> b
$ Parameter -> CatName
paramName Parameter
p}

checkBody :: Exp -> Exp
checkBody :: Exp -> Exp
checkBody (App Label
l FunType
t [Exp]
exps)   = Label -> FunType -> [Exp] -> Exp
App (Label -> Label
checkLabel Label
l) FunType
t (Exp -> Exp
checkBody (Exp -> Exp) -> [Exp] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp]
exps)
checkBody (Var Parameter
p)          = Parameter -> Exp
Var (Parameter -> Exp) -> Parameter -> Exp
forall a b. (a -> b) -> a -> b
$ Parameter -> Parameter
checkPar Parameter
p
checkBody e :: Exp
e@(LitInteger Integer
_) = Exp
e
checkBody e :: Exp
e@(LitDouble Double
_)  = Exp
e
checkBody e :: Exp
e@(LitChar Char
_)    = Exp
e
checkBody e :: Exp
e@(LitString [Char]
_)  = Exp
e

-- | Avoid reserved words in parser rules labels.

checkRuleLabel :: RuleLabel -> RuleLabel
checkRuleLabel :: RuleLabel -> RuleLabel
checkRuleLabel RuleLabel
rl = RuleLabel
rl { ruleLabel :: Label
ruleLabel = Label -> Label
checkLabel (Label -> Label) -> Label -> Label
forall a b. (a -> b) -> a -> b
$ RuleLabel -> Label
ruleLabel RuleLabel
rl}

checkLabel :: Label -> Label
checkLabel :: Label -> Label
checkLabel l :: Label
l@(LId CatName
_) = Label
l
checkLabel (LDef CatName
lName) = CatName -> Label
LDef (CatName -> Label) -> CatName -> Label
forall a b. (a -> b) -> a -> b
$ CatName -> CatName
avoidReservedWords1 CatName
lName
checkLabel Label
LWild = Label
LWild
checkLabel Label
LNil = Label
LNil
checkLabel Label
LSg = Label
LSg
checkLabel Label
LCons = Label
LCons