{-# LANGUAGE LambdaCase #-}

module BNFC.Backend.C.RegToFlex (printRegFlex) where

-- modified from pretty-printer generated by the BNF converter

import Data.Char (ord, showLitChar)
import qualified Data.List as List

import BNFC.Abs
import BNFC.Backend.Common (flexEps)

-- the top-level printing method
printRegFlex :: Reg -> String
printRegFlex :: Reg -> String
printRegFlex = [String] -> String
render ([String] -> String) -> (Reg -> [String]) -> Reg -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
0

-- you may want to change render and parenth

render :: [String] -> String
render :: [String] -> String
render = Int -> [String] -> String
forall t. t -> [String] -> String
rend (Int
0::Int) where
  rend :: t -> [String] -> String
rend t
i [String]
ss = case [String]
ss of
    String
"["      :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
"["  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
"("      :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
"("  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
t  : String
"," :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
t    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. [a] -> [a] -> [a]
space String
"," (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
t  : String
")" :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
t    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
")"  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
t  : String
"]" :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
t    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
"]"  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
t        :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
space String
t   (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    [String]
_            -> String
""
  cons :: [a] -> [a] -> [a]
cons [a]
s [a]
t  = [a]
s [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
t
  space :: [a] -> [a] -> [a]
space [a]
t [a]
s = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
s then [a]
t else [a]
t [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
s

parenth :: [String] -> [String]
parenth :: [String] -> [String]
parenth [String]
ss = [String
"("] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ss [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]

-- the printer class does the job
class Print a where
  prt :: Int -> a -> [String]

prPrec :: Int -> Int -> [String] -> [String]
prPrec :: Int -> Int -> [String] -> [String]
prPrec Int
i Int
j = if Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
i then [String] -> [String]
parenth else [String] -> [String]
forall a. a -> a
id

instance Print Identifier where
  prt :: Int -> Identifier -> [String]
prt Int
_ (Identifier ((Int, Int)
_, String
i)) = [String
i]

instance Print Reg where
  prt :: Int -> Reg -> [String]
prt Int
i = \case
   RSeq Reg
reg0 Reg
reg -> Int -> Int -> [String] -> [String]
prPrec Int
i Int
2 ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
2 Reg
reg0 , Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
3 Reg
reg])
   RAlt Reg
reg0 Reg
reg -> Int -> Int -> [String] -> [String]
prPrec Int
i Int
1 ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
1 Reg
reg0 , [String
"|"] , Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
2 Reg
reg])

   -- Flex does not support set difference. See link for valid patterns.
   -- https://westes.github.io/flex/manual/Patterns.html#Patterns
   -- RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg])
   RMinus Reg
reg0 Reg
REps -> Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
i Reg
reg0 -- REps is identity for set difference
   RMinus Reg
RAny (RChar Char
c)   -> [ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"[^", Char -> String
escapeChar Char
c,             String
"]" ] ]
   RMinus Reg
RAny (RAlts String
str) -> [ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"[^", (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeChar String
str, String
"]" ] ]
     -- FIXME: unicode inside brackets [...] is not accepted by flex
   -- FIXME: maybe we could add cases for char - RDigit, RLetter etc.
   RMinus Reg
_ Reg
_ -> String -> [String]
forall a. HasCallStack => String -> a
error  String
"Flex does not support general set difference"

   RStar Reg
reg -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
3 Reg
reg , [String
"*"] ]
   RPlus Reg
reg -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
3 Reg
reg , [String
"+"] ]
   ROpt Reg
reg  -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
3 Reg
reg , [String
"?"] ]
   Reg
REps      -> [ String
flexEps ]
   RChar Char
c   -> [ Char -> String
escapeChar Char
c ]
   -- Unicode characters cannot be inside [...] so we use | instead.
   RAlts String
str -> Int -> Int -> [String] -> [String]
prPrec Int
i Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
List.intersperse String
"|" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
escapeChar String
str
     -- RAlts str -> concat [["["], prt 0 $ concatMap escapeChar str, ["]"]]
   RSeqs String
str -> Int -> Int -> [String] -> [String]
prPrec Int
i Int
2 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
escapeChar String
str
   Reg
RDigit    -> [ String
"{DIGIT}"   ]
   Reg
RLetter   -> [ String
"{LETTER}"  ]
   Reg
RUpper    -> [ String
"{CAPITAL}" ]
   Reg
RLower    -> [ String
"{SMALL}"   ]
   Reg
RAny      -> [ String
"."         ]

-- | Handle special characters in regular expressions.

escapeChar :: Char -> String
escapeChar :: Char -> String
escapeChar Char
c
  | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
reserved       = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:[Char
c]
  | let x :: Int
x = Char -> Int
ord Char
c, Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 = [Char
c]  -- keep unicode characters -- "\x" ++ showHex x ""
  | Bool
otherwise               = Char -> String -> String
showLitChar Char
c String
""
  where
  reserved :: String
  reserved :: String
reserved = String
" $+-*=<>[](){}!?.,;:^~|&%#/\\$_@\""