module SaveProdRules where
import Data.Hashable
import System.IO
import System.Directory
import CFG
saveProdRules :: String -> String -> [String] -> IO Bool
saveProdRules :: String -> String -> [String] -> IO Bool
saveProdRules String
fileName String
startSymbol [String]
prodRuleStrs = do
String -> String -> IO Bool
writeOnceWithHash String
fileName String
grmStrLn
where
grmStr :: String
grmStr = String -> [String] -> String
toCFG String
startSymbol [String]
prodRuleStrs
grmStrLn :: String
grmStrLn = String
grmStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
toCFG :: String -> [String] -> String
toCFG :: String -> [String] -> String
toCFG String
startSymbol [String]
prodRuleStrs =
String
"CFG " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
startSymbol String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" [\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String -> String
concatWith ([String] -> [String]
toProdRules [String]
prodRuleStrs) String
",\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n ]"
toProdRules :: [String] -> [String]
toProdRules :: [String] -> [String]
toProdRules [String]
productionRuleStrs = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> [String] -> String
toProdRule [String]
lhsStrs) [[String]]
lhsRhsStrss
where
lhsStrs :: [String]
lhsStrs = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
forall a. [a] -> a
head [[String]]
lhsRhsStrss
lhsRhsStrss :: [[String]]
lhsRhsStrss = (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
tokenizeLhs [String]
productionRuleStrs
toProdRule :: [String] -> [String] -> String
toProdRule :: [String] -> [String] -> String
toProdRule [String]
lhsStrs (String
lhs:[String]
rhsStrs) =
String
" ProductionRule " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
lhs String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String -> String
concatWith ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String -> String
toSymbol [String]
lhsStrs) [String]
rhsStrs) String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
toSymbol :: [String] -> String -> String
toSymbol :: [String] -> String -> String
toSymbol [String]
lhsStrs String
sym
| String
sym String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lhsStrs = String
"Nonterminal " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
sym
| Bool
otherwise = String
"Terminal " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
sym
tokenizeLhs :: String -> [String]
tokenizeLhs :: String -> [String]
tokenizeLhs String
str =
case ReadS String
lex String
str of
[] -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No lhs found (1)"
[(String
"",String
therest)] -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No lhs found (2)"
[(String
lhs,String
therest)] -> String
lhs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
tokenizeArrow String
therest
tokenizeArrow :: String -> [String]
tokenizeArrow :: String -> [String]
tokenizeArrow String
str =
case ReadS String
lex String
str of
[] -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No arrow found (1)"
[(String
"",String
therest)] -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No arrow found (2)"
[(arrow :: String
arrow@String
"->",String
therest)] -> String -> [String]
tokenizeRhs String
therest
[(String
token,String
therest)] -> String -> [String]
forall a. HasCallStack => String -> a
error (String
"No arrow found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
token)
tokenizeRhs :: String -> [String]
tokenizeRhs :: String -> [String]
tokenizeRhs String
str =
case ReadS String
lex String
str of
[] -> []
[(String
"",String
therest)] -> []
[(String
token,String
therest)] -> String
token String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
tokenizeRhs String
therest
concatWith :: [String] -> String -> String
concatWith :: [String] -> String -> String
concatWith [] String
sep = String
""
concatWith [String
a] String
sep = String
a
concatWith (String
a:String
b:[String]
theRest) String
sep = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String -> String
concatWith (String
bString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
theRest) String
sep
getHashFileName :: String -> String
getHashFileName String
fileName = String
fileName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".hash"
writeOnceWithHash :: String -> String -> IO Bool
writeOnceWithHash :: String -> String -> IO Bool
writeOnceWithHash String
fileName String
text = do
let hashFileName :: String
hashFileName = String -> String
getHashFileName String
fileName
let newHash :: Int
newHash = String -> Int
forall a. Hashable a => a -> Int
hash String
text
Bool
fileExists <- String -> IO Bool
doesFileExist String
fileName
Bool
hashExists <- String -> IO Bool
doesFileExist String
hashFileName
case Bool
fileExists Bool -> Bool -> Bool
&& Bool
hashExists of
Bool
False -> do
String -> String -> IO ()
writeFile String
fileName String
text
String -> String -> IO ()
writeFile String
hashFileName (Int -> String
forall a. Show a => a -> String
show Int
newHash)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
True -> do
String
existingHashStr <- String -> IO String
readFile String
hashFileName
case Int
newHash Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Int
forall a. Read a => String -> a
read String
existingHashStr :: Int) of
Bool
True -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Bool
False -> do
String -> String -> IO ()
writeFile String
fileName String
text
String -> String -> IO ()
writeFile String
hashFileName (Int -> String
forall a. Show a => a -> String
show Int
newHash)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True