module Ag (uuagcLib, uuagcExe,compile) where
import System.Environment (getArgs, getProgName)
import System.Console.GetOpt (usageInfo)
import Data.List (partition)
import Control.Monad (zipWithM_,when)
import Data.Maybe
import System.FilePath
import System.IO
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Sequence as Seq ((><),null)
import Data.Foldable(toList)
import Pretty
import PPUtil
import UU.Parsing (Message(..), Action(..))
import UU.Scanner.Position (Pos, line, file)
import UU.Scanner.Token (Token)
import qualified Transform as Pass1 (sem_AG , wrap_AG , Syn_AG (..), Inh_AG (..))
import qualified Desugar as Pass1a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified DefaultRules as Pass2 (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified ResolveLocals as Pass2a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified Order as Pass3 (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified LOAG.Order as Pass3b (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified KWOrder as Pass3a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified GenerateCode as Pass4 (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..))
import qualified PrintVisitCode as Pass4a (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..))
import qualified ExecutionPlan2Hs as Pass4b (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..), warrenFlagsPP)
import qualified ExecutionPlan2Caml as Pass4c (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..))
import qualified ExecutionPlan2Clean as Pass4d (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..), mkIclModuleHeader, mkDclModuleHeader, cleanIclModuleHeader, cleanDclModuleHeader)
import qualified PrintCode as Pass5 (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..))
import qualified PrintOcamlCode as Pass5a (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..))
import qualified PrintCleanCode as Pass5b (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..))
import qualified PrintErrorMessages as PrErr (sem_Errors , wrap_Errors , Syn_Errors (..), Inh_Errors (..), isError)
import qualified TfmToVisage as PassV (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified TfmToMirage as PassM (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified AbstractSyntaxDump as GrammarDump (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import qualified CodeSyntaxDump as CGrammarDump (sem_CGrammar, wrap_CGrammar, Syn_CGrammar (..), Inh_CGrammar (..))
import qualified Visage as VisageDump (sem_VisageGrammar, wrap_VisageGrammar, Syn_VisageGrammar(..), Inh_VisageGrammar(..))
import qualified AG2AspectAG as AspectAGDump (pragmaAspectAG, sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..))
import Options
import Version (banner)
import Parser (parseAG, depsAG, parseAGI)
import ErrorMessages (Error(ParserError))
import CommonTypes
import ATermWrite
import Data.Aeson (encode)
import qualified Data.ByteString.Lazy as ByteString
import System.Exit (ExitCode(..), exitWith)
uuagcLib :: [String] -> FilePath -> IO (ExitCode, [FilePath])
uuagcLib :: [String] -> String -> IO (ExitCode, [String])
uuagcLib [String]
args String
fileP
= do let (Options
flags,[String]
_,[String]
errs) = [String] -> (Options, [String], [String])
getOptions [String]
args
if Options -> Bool
showVersion Options
flags Bool -> Bool -> Bool
|| Options -> Bool
showHelp Options
flags
then do String -> IO ()
putStrLn String
"Cannot display help or version in library mode."
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1, [])
else if (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
errs
then do String -> IO ()
putStrLn String
"One or more errors occured:"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
errs
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
2, [])
else if Options -> Bool
genFileDeps Options
flags
then do [String]
deps <- Options -> [String] -> IO [String]
getDeps Options
flags [String
fileP]
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, [String]
deps)
else do Options -> String -> String -> IO ()
compile Options
flags String
fileP (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Options -> [String]
outputFiles Options
flagsforall a. [a] -> [a] -> [a]
++forall a. a -> [a]
repeat String
"")
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, [])
uuagcExe :: IO ()
uuagcExe :: IO ()
uuagcExe
= do [String]
args <- IO [String]
getArgs
String
progName <- IO String
getProgName
let usageheader :: String
usageheader = String
"Usage info:\n " forall a. [a] -> [a] -> [a]
++ String
progName forall a. [a] -> [a] -> [a]
++ String
" options file ...\n\nList of options:"
(Options
flags,[String]
files,[String]
errs) = [String] -> (Options, [String], [String])
getOptions [String]
args
if Options -> Bool
showVersion Options
flags
then String -> IO ()
putStrLn String
banner
else if Options -> Bool
showHelp Options
flags
then String -> IO ()
putStrLn (forall a. String -> [OptDescr a] -> String
usageInfo String
usageheader [OptDescr (Options -> Options)]
options)
else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files Bool -> Bool -> Bool
|| (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
errs
then do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn (forall a. String -> [OptDescr a] -> String
usageInfo String
usageheader [OptDescr (Options -> Options)]
options forall a. a -> [a] -> [a]
: [String]
errs)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
2)
else if Options -> Bool
genFileDeps Options
flags
then Options -> [String] -> IO ()
reportDeps Options
flags [String]
files
else forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Options -> String -> String -> IO ()
compile Options
flags) [String]
files (Options -> [String]
outputFiles Options
flagsforall a. [a] -> [a] -> [a]
++forall a. a -> [a]
repeat String
"")
compile :: Options -> FilePath -> FilePath -> IO ()
compile :: Options -> String -> String -> IO ()
compile Options
flags String
input String
output
= do (AG
output0,[Message Token Pos]
parseErrors) <- Options -> [String] -> String -> IO (AG, [Message Token Pos])
parseAG Options
flags (Options -> [String]
searchPath Options
flags) String
input
AttrMap
irrefutableMap <- Options -> IO AttrMap
readIrrefutableMap Options
flags
let printStr :: String -> IO ()
printStr = Options -> String -> IO ()
outputStr Options
flags
failWith :: Int -> IO ()
failWith = Options -> Int -> IO ()
failWithCode Options
flags
inputfile :: String
inputfile = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
input forall a. a -> a
id (Options -> Maybe String
mainFilename Options
flags)
let output1 :: Syn_AG
output1 = T_AG -> Inh_AG -> Syn_AG
Pass1.wrap_AG (AG -> T_AG
Pass1.sem_AG AG
output0 ) Pass1.Inh_AG {options_Inh_AG :: Options
Pass1.options_Inh_AG = Options
flags}
flags' :: Options
flags' = Options -> Options
condDisableOptimizations (Syn_AG -> Options -> Options
Pass1.pragmas_Syn_AG Syn_AG
output1 Options
flags)
grammar1 :: Grammar
grammar1 = Syn_AG -> Grammar
Pass1.output_Syn_AG Syn_AG
output1
output1a :: Syn_Grammar
output1a = T_Grammar -> Inh_Grammar -> Syn_Grammar
Pass1a.wrap_Grammar (Grammar -> T_Grammar
Pass1a.sem_Grammar Grammar
grammar1 ) Pass1a.Inh_Grammar {options_Inh_Grammar :: Options
Pass1a.options_Inh_Grammar = Options
flags', forcedIrrefutables_Inh_Grammar :: AttrMap
Pass1a.forcedIrrefutables_Inh_Grammar = AttrMap
irrefutableMap, mainName_Inh_Grammar :: String
Pass1a.mainName_Inh_Grammar = String
mainName }
grammar1a :: Grammar
grammar1a = Syn_Grammar -> Grammar
Pass1a.output_Syn_Grammar Syn_Grammar
output1a
output2 :: Syn_Grammar
output2 = T_Grammar -> Inh_Grammar -> Syn_Grammar
Pass2.wrap_Grammar (Grammar -> T_Grammar
Pass2.sem_Grammar Grammar
grammar1a ) Pass2.Inh_Grammar {options_Inh_Grammar :: Options
Pass2.options_Inh_Grammar = Options
flags', constructorTypeMap_Inh_Grammar :: Map NontermIdent ConstructorType
Pass2.constructorTypeMap_Inh_Grammar = Syn_AG -> Map NontermIdent ConstructorType
Pass1.constructorTypeMap_Syn_AG Syn_AG
output1}
grammar2 :: Grammar
grammar2 = Syn_Grammar -> Grammar
Pass2.output_Syn_Grammar Syn_Grammar
output2
outputV :: Syn_Grammar
outputV = T_Grammar -> Inh_Grammar -> Syn_Grammar
PassV.wrap_Grammar (Grammar -> T_Grammar
PassV.sem_Grammar Grammar
grammar2 ) PassV.Inh_Grammar {}
grammarV :: VisageGrammar
grammarV = Syn_Grammar -> VisageGrammar
PassV.visage_Syn_Grammar Syn_Grammar
outputV
outputM :: Syn_Grammar
outputM = T_Grammar -> Inh_Grammar -> Syn_Grammar
PassM.wrap_Grammar (Grammar -> T_Grammar
PassM.sem_Grammar Grammar
grammar2 ) PassM.Inh_Grammar {options_Inh_Grammar :: Options
PassM.options_Inh_Grammar = Options
flags'}
output2a :: Syn_Grammar
output2a = T_Grammar -> Inh_Grammar -> Syn_Grammar
Pass2a.wrap_Grammar (Grammar -> T_Grammar
Pass2a.sem_Grammar Grammar
grammar2 ) Pass2a.Inh_Grammar {options_Inh_Grammar :: Options
Pass2a.options_Inh_Grammar = Options
flags'}
grammar2a :: Grammar
grammar2a = Syn_Grammar -> Grammar
Pass2a.output_Syn_Grammar Syn_Grammar
output2a
output3 :: Syn_Grammar
output3 = T_Grammar -> Inh_Grammar -> Syn_Grammar
Pass3.wrap_Grammar (Grammar -> T_Grammar
Pass3.sem_Grammar Grammar
grammar2a ) Pass3.Inh_Grammar {options_Inh_Grammar :: Options
Pass3.options_Inh_Grammar = Options
flags'}
grammar3 :: CGrammar
grammar3 = Syn_Grammar -> CGrammar
Pass3.output_Syn_Grammar Syn_Grammar
output3
output3a :: Syn_Grammar
output3a = T_Grammar -> Inh_Grammar -> Syn_Grammar
Pass3a.wrap_Grammar (Grammar -> T_Grammar
Pass3a.sem_Grammar Grammar
grammar2a ) Pass3a.Inh_Grammar {options_Inh_Grammar :: Options
Pass3a.options_Inh_Grammar = Options
flags'}
output3b :: Syn_Grammar
output3b = T_Grammar -> Inh_Grammar -> Syn_Grammar
Pass3b.wrap_Grammar (Grammar -> T_Grammar
Pass3b.sem_Grammar Grammar
grammar2a ) Pass3b.Inh_Grammar {options_Inh_Grammar :: Options
Pass3b.options_Inh_Grammar = Options
flags'}
grammar3a :: ExecutionPlan
grammar3a | Options -> Bool
loag Options
flags' = Syn_Grammar -> ExecutionPlan
Pass3b.output_Syn_Grammar Syn_Grammar
output3b
| Bool
otherwise = Syn_Grammar -> ExecutionPlan
Pass3a.output_Syn_Grammar Syn_Grammar
output3a
output4 :: Syn_CGrammar
output4 = T_CGrammar -> Inh_CGrammar -> Syn_CGrammar
Pass4.wrap_CGrammar (CGrammar -> T_CGrammar
Pass4.sem_CGrammar(Syn_Grammar -> CGrammar
Pass3.output_Syn_Grammar Syn_Grammar
output3)) Pass4.Inh_CGrammar {options_Inh_CGrammar :: Options
Pass4.options_Inh_CGrammar = Options
flags'}
output4a :: Syn_CGrammar
output4a = T_CGrammar -> Inh_CGrammar -> Syn_CGrammar
Pass4a.wrap_CGrammar (CGrammar -> T_CGrammar
Pass4a.sem_CGrammar(Syn_Grammar -> CGrammar
Pass3.output_Syn_Grammar Syn_Grammar
output3)) Pass4a.Inh_CGrammar {options_Inh_CGrammar :: Options
Pass4a.options_Inh_CGrammar = Options
flags'}
output4b :: Syn_ExecutionPlan
output4b = T_ExecutionPlan -> Inh_ExecutionPlan -> Syn_ExecutionPlan
Pass4b.wrap_ExecutionPlan (ExecutionPlan -> T_ExecutionPlan
Pass4b.sem_ExecutionPlan ExecutionPlan
grammar3a) Pass4b.Inh_ExecutionPlan {options_Inh_ExecutionPlan :: Options
Pass4b.options_Inh_ExecutionPlan = Options
flags', inhmap_Inh_ExecutionPlan :: Map NontermIdent Attributes
Pass4b.inhmap_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent Attributes
Pass3a.inhmap_Syn_Grammar Syn_Grammar
output3a, synmap_Inh_ExecutionPlan :: Map NontermIdent Attributes
Pass4b.synmap_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent Attributes
Pass3a.synmap_Syn_Grammar Syn_Grammar
output3a, pragmaBlocks_Inh_ExecutionPlan :: String
Pass4b.pragmaBlocks_Inh_ExecutionPlan = String
pragmaBlocksTxt, importBlocks_Inh_ExecutionPlan :: PP_Doc
Pass4b.importBlocks_Inh_ExecutionPlan = PP_Doc
importBlocksTxt, textBlocks_Inh_ExecutionPlan :: PP_Doc
Pass4b.textBlocks_Inh_ExecutionPlan = PP_Doc
textBlocksDoc, moduleHeader_Inh_ExecutionPlan :: String -> String -> String -> Bool -> String
Pass4b.moduleHeader_Inh_ExecutionPlan = Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
mkModuleHeader forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1, mainName_Inh_ExecutionPlan :: String
Pass4b.mainName_Inh_ExecutionPlan = String -> Maybe (String, String, String) -> String
mkMainName String
mainName forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1, mainFile_Inh_ExecutionPlan :: String
Pass4b.mainFile_Inh_ExecutionPlan = String
mainFile, textBlockMap_Inh_ExecutionPlan :: Map BlockInfo PP_Doc
Pass4b.textBlockMap_Inh_ExecutionPlan = Map BlockInfo PP_Doc
textBlockMap, mainBlocksDoc_Inh_ExecutionPlan :: PP_Doc
Pass4b.mainBlocksDoc_Inh_ExecutionPlan = PP_Doc
mainBlocksDoc,localAttrTypes_Inh_ExecutionPlan :: Map NontermIdent (Map NontermIdent Attributes)
Pass4b.localAttrTypes_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent (Map NontermIdent Attributes)
Pass3a.localSigMap_Syn_Grammar Syn_Grammar
output3a}
output4c :: Syn_ExecutionPlan
output4c = T_ExecutionPlan -> Inh_ExecutionPlan -> Syn_ExecutionPlan
Pass4c.wrap_ExecutionPlan (ExecutionPlan -> T_ExecutionPlan
Pass4c.sem_ExecutionPlan ExecutionPlan
grammar3a) Pass4c.Inh_ExecutionPlan {options_Inh_ExecutionPlan :: Options
Pass4c.options_Inh_ExecutionPlan = Options
flags', inhmap_Inh_ExecutionPlan :: Map NontermIdent Attributes
Pass4c.inhmap_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent Attributes
Pass3a.inhmap_Syn_Grammar Syn_Grammar
output3a, synmap_Inh_ExecutionPlan :: Map NontermIdent Attributes
Pass4c.synmap_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent Attributes
Pass3a.synmap_Syn_Grammar Syn_Grammar
output3a, mainName_Inh_ExecutionPlan :: String
Pass4c.mainName_Inh_ExecutionPlan = String -> Maybe (String, String, String) -> String
mkMainName String
mainName forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1, mainFile_Inh_ExecutionPlan :: String
Pass4c.mainFile_Inh_ExecutionPlan = String
mainFile, localAttrTypes_Inh_ExecutionPlan :: Map NontermIdent (Map NontermIdent Attributes)
Pass4c.localAttrTypes_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent (Map NontermIdent Attributes)
Pass3a.localSigMap_Syn_Grammar Syn_Grammar
output3a}
output4d :: Syn_ExecutionPlan
output4d = T_ExecutionPlan -> Inh_ExecutionPlan -> Syn_ExecutionPlan
Pass4d.wrap_ExecutionPlan (ExecutionPlan -> T_ExecutionPlan
Pass4d.sem_ExecutionPlan ExecutionPlan
grammar3a) Pass4d.Inh_ExecutionPlan {options_Inh_ExecutionPlan :: Options
Pass4d.options_Inh_ExecutionPlan = Options
flags', inhmap_Inh_ExecutionPlan :: Map NontermIdent Attributes
Pass4d.inhmap_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent Attributes
Pass3a.inhmap_Syn_Grammar Syn_Grammar
output3a, synmap_Inh_ExecutionPlan :: Map NontermIdent Attributes
Pass4d.synmap_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent Attributes
Pass3a.synmap_Syn_Grammar Syn_Grammar
output3a, importBlocks_Inh_ExecutionPlan :: PP_Doc
Pass4d.importBlocks_Inh_ExecutionPlan = PP_Doc
importBlocksTxt, textBlocks_Inh_ExecutionPlan :: PP_Doc
Pass4d.textBlocks_Inh_ExecutionPlan = PP_Doc
textBlocksDoc, iclModuleHeader_Inh_ExecutionPlan :: String -> String -> String -> Bool -> String
Pass4d.iclModuleHeader_Inh_ExecutionPlan = Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
Pass4d.mkIclModuleHeader forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1, dclModuleHeader_Inh_ExecutionPlan :: String -> String -> String -> Bool -> String
Pass4d.dclModuleHeader_Inh_ExecutionPlan = Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
Pass4d.mkDclModuleHeader forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1, mainName_Inh_ExecutionPlan :: String
Pass4d.mainName_Inh_ExecutionPlan = String -> Maybe (String, String, String) -> String
mkMainName String
mainName forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1, mainFile_Inh_ExecutionPlan :: String
Pass4d.mainFile_Inh_ExecutionPlan = String
mainFile, textBlockMap_Inh_ExecutionPlan :: Map BlockInfo PP_Doc
Pass4d.textBlockMap_Inh_ExecutionPlan = Map BlockInfo PP_Doc
textBlockMap, mainBlocksDoc_Inh_ExecutionPlan :: PP_Doc
Pass4d.mainBlocksDoc_Inh_ExecutionPlan = PP_Doc
mainBlocksDoc,localAttrTypes_Inh_ExecutionPlan :: Map NontermIdent (Map NontermIdent Attributes)
Pass4d.localAttrTypes_Inh_ExecutionPlan = Syn_Grammar -> Map NontermIdent (Map NontermIdent Attributes)
Pass3a.localSigMap_Syn_Grammar Syn_Grammar
output3a, constructorTypeMap_Inh_ExecutionPlan :: Map NontermIdent ConstructorType
Pass4d.constructorTypeMap_Inh_ExecutionPlan = Syn_AG -> Map NontermIdent ConstructorType
Pass1.constructorTypeMap_Syn_AG Syn_AG
output1}
output5 :: Syn_Program
output5 = T_Program -> Inh_Program -> Syn_Program
Pass5.wrap_Program (Program -> T_Program
Pass5.sem_Program (Syn_CGrammar -> Program
Pass4.output_Syn_CGrammar Syn_CGrammar
output4)) Pass5.Inh_Program {options_Inh_Program :: Options
Pass5.options_Inh_Program = Options
flags', pragmaBlocks_Inh_Program :: String
Pass5.pragmaBlocks_Inh_Program = String
pragmaBlocksTxt, importBlocks_Inh_Program :: PP_Doc
Pass5.importBlocks_Inh_Program = PP_Doc
importBlocksTxt, textBlocks_Inh_Program :: PP_Doc
Pass5.textBlocks_Inh_Program = PP_Doc
textBlocksDoc, textBlockMap_Inh_Program :: Map BlockInfo PP_Doc
Pass5.textBlockMap_Inh_Program = Map BlockInfo PP_Doc
textBlockMap, mainBlocksDoc_Inh_Program :: PP_Doc
Pass5.mainBlocksDoc_Inh_Program = PP_Doc
mainBlocksDoc, optionsLine_Inh_Program :: String
Pass5.optionsLine_Inh_Program = String
optionsLine, mainFile_Inh_Program :: String
Pass5.mainFile_Inh_Program = String
mainFile, moduleHeader_Inh_Program :: String -> String -> String -> Bool -> String
Pass5.moduleHeader_Inh_Program = Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
mkModuleHeader forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1, mainName_Inh_Program :: String
Pass5.mainName_Inh_Program = String -> Maybe (String, String, String) -> String
mkMainName String
mainName forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1}
output5a :: Syn_Program
output5a = T_Program -> Inh_Program -> Syn_Program
Pass5a.wrap_Program (Program -> T_Program
Pass5a.sem_Program (Syn_CGrammar -> Program
Pass4.output_Syn_CGrammar Syn_CGrammar
output4)) Pass5a.Inh_Program { options_Inh_Program :: Options
Pass5a.options_Inh_Program = Options
flags', textBlockMap_Inh_Program :: Map BlockInfo PP_Doc
Pass5a.textBlockMap_Inh_Program = Map BlockInfo PP_Doc
textBlockMap }
output5b :: Syn_Program
output5b = T_Program -> Inh_Program -> Syn_Program
Pass5b.wrap_Program (Program -> T_Program
Pass5b.sem_Program (Syn_CGrammar -> Program
Pass4.output_Syn_CGrammar Syn_CGrammar
output4)) Pass5b.Inh_Program {options_Inh_Program :: Options
Pass5b.options_Inh_Program = Options
flags', pragmaBlocks_Inh_Program :: String
Pass5b.pragmaBlocks_Inh_Program = String
pragmaBlocksTxt, importBlocks_Inh_Program :: PP_Doc
Pass5b.importBlocks_Inh_Program = PP_Doc
importBlocksTxt, textBlocks_Inh_Program :: PP_Doc
Pass5b.textBlocks_Inh_Program = PP_Doc
textBlocksDoc, textBlockMap_Inh_Program :: Map BlockInfo PP_Doc
Pass5b.textBlockMap_Inh_Program = Map BlockInfo PP_Doc
textBlockMap, mainBlocksDoc_Inh_Program :: PP_Doc
Pass5b.mainBlocksDoc_Inh_Program = PP_Doc
mainBlocksDoc, optionsLine_Inh_Program :: String
Pass5b.optionsLine_Inh_Program = String
optionsLine, mainFile_Inh_Program :: String
Pass5b.mainFile_Inh_Program = String
mainFile, moduleHeader_Inh_Program :: String -> String -> String -> Bool -> String
Pass5b.moduleHeader_Inh_Program = Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
mkModuleHeader forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1, mainName_Inh_Program :: String
Pass5b.mainName_Inh_Program = String -> Maybe (String, String, String) -> String
mkMainName String
mainName forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1}
output6 :: Syn_Errors
output6 = T_Errors -> Inh_Errors -> Syn_Errors
PrErr.wrap_Errors (Errors -> T_Errors
PrErr.sem_Errors Errors
errorsToReport) PrErr.Inh_Errors {options_Inh_Errors :: Options
PrErr.options_Inh_Errors = Options
flags', dups_Inh_Errors :: [String]
PrErr.dups_Inh_Errors = [] }
dump1 :: Syn_Grammar
dump1 = T_Grammar -> Inh_Grammar -> Syn_Grammar
GrammarDump.wrap_Grammar (Grammar -> T_Grammar
GrammarDump.sem_Grammar Grammar
grammar1 ) Inh_Grammar
GrammarDump.Inh_Grammar
dump2 :: Syn_Grammar
dump2 = T_Grammar -> Inh_Grammar -> Syn_Grammar
GrammarDump.wrap_Grammar (Grammar -> T_Grammar
GrammarDump.sem_Grammar Grammar
grammar2 ) Inh_Grammar
GrammarDump.Inh_Grammar
dump3 :: Syn_CGrammar
dump3 = T_CGrammar -> Inh_CGrammar -> Syn_CGrammar
CGrammarDump.wrap_CGrammar (CGrammar -> T_CGrammar
CGrammarDump.sem_CGrammar CGrammar
grammar3 ) Inh_CGrammar
CGrammarDump.Inh_CGrammar
outputVisage :: Syn_VisageGrammar
outputVisage = T_VisageGrammar -> Inh_VisageGrammar -> Syn_VisageGrammar
VisageDump.wrap_VisageGrammar (VisageGrammar -> T_VisageGrammar
VisageDump.sem_VisageGrammar VisageGrammar
grammarV) Inh_VisageGrammar
VisageDump.Inh_VisageGrammar
aterm :: ATerm
aterm = Syn_VisageGrammar -> ATerm
VisageDump.aterm_Syn_VisageGrammar Syn_VisageGrammar
outputVisage
mirage :: Grammar
mirage = Syn_Grammar -> Grammar
PassM.mirage_Syn_Grammar Syn_Grammar
outputM
parseErrorList :: Errors
parseErrorList = forall a b. (a -> b) -> [a] -> [b]
map Message Token Pos -> Error
message2error ([Message Token Pos]
parseErrors)
mainErrors :: Errors
mainErrors = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_AG -> Seq Error
Pass1.errors_Syn_AG Syn_AG
output1
forall a. Seq a -> Seq a -> Seq a
Seq.>< Syn_Grammar -> Seq Error
Pass1a.errors_Syn_Grammar Syn_Grammar
output1a
forall a. Seq a -> Seq a -> Seq a
Seq.>< Syn_Grammar -> Seq Error
Pass2.errors_Syn_Grammar Syn_Grammar
output2
forall a. Seq a -> Seq a -> Seq a
Seq.>< Syn_Grammar -> Seq Error
Pass2a.errors_Syn_Grammar Syn_Grammar
output2a)
furtherErrors :: Errors
furtherErrors = if Options -> Bool
loag Options
flags'
then forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Syn_Grammar -> Seq Error
Pass3b.errors_Syn_Grammar Syn_Grammar
output3b)
else if Options -> Bool
kennedyWarren Options
flags'
then let errs3a :: Seq Error
errs3a = Syn_Grammar -> Seq Error
Pass3a.errors_Syn_Grammar Syn_Grammar
output3a
in if forall a. Seq a -> Bool
Seq.null Seq Error
errs3a
then if Options -> Bool
ocaml Options
flags'
then forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_ExecutionPlan -> Seq Error
Pass4c.errors_Syn_ExecutionPlan Syn_ExecutionPlan
output4c )
else if Options -> Bool
clean Options
flags'
then forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_ExecutionPlan -> Seq Error
Pass4d.errors_Syn_ExecutionPlan Syn_ExecutionPlan
output4d )
else forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_ExecutionPlan -> Seq Error
Pass4b.errors_Syn_ExecutionPlan Syn_ExecutionPlan
output4b )
else forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Error
errs3a
else forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_Grammar -> Seq Error
Pass3.errors_Syn_Grammar Syn_Grammar
output3
forall a. Seq a -> Seq a -> Seq a
Seq.>< Syn_CGrammar -> Seq Error
Pass4.errors_Syn_CGrammar Syn_CGrammar
output4)
errorList :: Errors
errorList = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
parseErrorList
then Errors
mainErrors
forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. (a -> Bool) -> [a] -> [a]
filter (Options -> Error -> Bool
PrErr.isError Options
flags') Errors
mainErrors)
then Errors
furtherErrors
else []
else [forall a. [a] -> a
head Errors
parseErrorList]
fatalErrorList :: Errors
fatalErrorList = forall a. (a -> Bool) -> [a] -> [a]
filter (Options -> Error -> Bool
PrErr.isError Options
flags') Errors
errorList
allErrors :: Errors
allErrors = if Options -> Bool
wignore Options
flags'
then Errors
fatalErrorList
else Options -> Errors -> Errors
errorsToFront Options
flags' Errors
errorList
errorsToReport :: Errors
errorsToReport = forall a. Int -> [a] -> [a]
take (Options -> Int
wmaxerrs Options
flags') Errors
allErrors
errorsToStopOn :: Errors
errorsToStopOn = if Options -> Bool
werrors Options
flags'
then Errors
errorList
else Errors
fatalErrorList
blocks1 :: Blocks
blocks1 = (Syn_AG -> Blocks
Pass1.blocks_Syn_AG Syn_AG
output1)
(Blocks
pragmaBlocks, Blocks
blocks2) = forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\(BlockKind
k, Maybe NontermIdent
at) [([String], Pos)]
_->BlockKind
kforall a. Eq a => a -> a -> Bool
==BlockKind
BlockPragma Bool -> Bool -> Bool
&& Maybe NontermIdent
at forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing) Blocks
blocks1
(Blocks
importBlocks, Blocks
textBlocks) = forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\(BlockKind
k, Maybe NontermIdent
at) [([String], Pos)]
_->BlockKind
kforall a. Eq a => a -> a -> Bool
==BlockKind
BlockImport Bool -> Bool -> Bool
&& Maybe NontermIdent
at forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing) Blocks
blocks2
importBlocksTxt :: PP_Doc
importBlocksTxt = forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ Blocks
importBlocks
textBlocksDoc :: PP_Doc
textBlocksDoc = forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (BlockKind
BlockOther, forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
mainBlocksDoc :: PP_Doc
mainBlocksDoc = forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (BlockKind
BlockMain, forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
dataBlocksDoc :: PP_Doc
dataBlocksDoc = forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (BlockKind
BlockData, forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
recBlocksDoc :: PP_Doc
recBlocksDoc = forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (BlockKind
BlockRec, forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
pragmaBlocksTxt :: String
pragmaBlocksTxt = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ Blocks
pragmaBlocks
textBlockMap :: Map BlockInfo PP_Doc
textBlockMap = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(BlockKind
_, Maybe NontermIdent
at) [([String], Pos)]
_ -> Maybe NontermIdent
at forall a. Eq a => a -> a -> Bool
/= forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
outputfile :: String
outputfile = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
output then Options -> String -> String
outputFile Options
flags' String
inputfile else String
output
mainFile :: String
mainFile | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
output = Options -> String -> String
outputFile Options
flags' String
inputfile
| Bool
otherwise = String
output
mainName :: String
mainName = String -> String
dropExtension forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
inputfile
addLocationPragma :: ([String], Pos) -> PP_Doc
addLocationPragma :: ([String], Pos) -> PP_Doc
addLocationPragma ([String]
strs, Pos
p)
| Options -> Bool
genLinePragmas Options
flags' =
Options -> Int -> String -> PP_Doc
ppLinePragma Options
flags' (forall p. Position p => p -> Int
line Pos
p) (forall p. Position p => p -> String
file Pos
p) forall a b. (PP a, PP b) => a -> b -> PP_Doc
>-< forall a. PP a => [a] -> PP_Doc
vlist (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> PP_Doc
pp [String]
strs)
forall a b. (PP a, PP b) => a -> b -> PP_Doc
>-< forall a. PP a => (Int -> a) -> PP_Doc
ppWithLineNr (\Int
l -> Options -> Int -> String -> PP_Doc
ppLinePragma Options
flags' (Int
lforall a. Num a => a -> a -> a
+Int
1) String
outputfile)
| Bool
otherwise = forall a. PP a => [a] -> PP_Doc
vlist (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> PP_Doc
pp [String]
strs)
optionsGHC :: [String]
optionsGHC = forall {a}. Bool -> a -> [a]
option (Options -> Bool
unbox Options
flags') String
"-fglasgow-exts" forall a. [a] -> [a] -> [a]
++ forall {a}. Bool -> a -> [a]
option (Options -> Bool
bangpats Options
flags') String
"-XBangPatterns"
option :: Bool -> a -> [a]
option Bool
True a
s = [a
s]
option Bool
False a
_ = []
optionsLine :: String
optionsLine | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optionsGHC = String
""
| Bool
otherwise = String
"{-# OPTIONS_GHC " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
optionsGHC forall a. [a] -> [a] -> [a]
++ String
" #-}"
nrOfErrorsToReport :: Int
nrOfErrorsToReport = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Options -> Error -> Bool
PrErr.isError Options
flags') Errors
errorsToReport
nrOfWarningsToReport :: Int
nrOfWarningsToReport = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.(Options -> Error -> Bool
PrErr.isError Options
flags')) Errors
errorsToReport
totalNrOfErrors :: Int
totalNrOfErrors = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Options -> Error -> Bool
PrErr.isError Options
flags') Errors
allErrors
totalNrOfWarnings :: Int
totalNrOfWarnings = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.(Options -> Error -> Bool
PrErr.isError Options
flags')) Errors
allErrors
additionalErrors :: Int
additionalErrors = Int
totalNrOfErrors forall a. Num a => a -> a -> a
- Int
nrOfErrorsToReport
additionalWarnings :: Int
additionalWarnings = Int
totalNrOfWarnings forall a. Num a => a -> a -> a
- Int
nrOfWarningsToReport
pluralS :: a -> String
pluralS a
n = if a
n forall a. Eq a => a -> a -> Bool
== a
1 then String
"" else String
"s"
(AG
outAgi, Maybe String
ext) <-
if Options -> Bool
genAspectAG Options
flags'
then Options -> [String] -> String -> IO (AG, Maybe String)
parseAGI Options
flags (Options -> [String]
searchPath Options
flags) (String -> String
agiFile String
input)
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasCallStack => a
undefined, forall a. HasCallStack => a
undefined)
let ext' :: Maybe String
ext' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
remAgi Maybe String
ext
outAgi1 :: Syn_AG
outAgi1 = T_AG -> Inh_AG -> Syn_AG
Pass1.wrap_AG (AG -> T_AG
Pass1.sem_AG AG
outAgi ) Pass1.Inh_AG {options_Inh_AG :: Options
Pass1.options_Inh_AG = Options
flags'}
agi :: (Set NontermIdent, DataTypes,
Map NontermIdent (Attributes, Attributes))
agi = Syn_AG
-> (Set NontermIdent, DataTypes,
Map NontermIdent (Attributes, Attributes))
Pass1.agi_Syn_AG Syn_AG
outAgi1
aspectAG :: Syn_Grammar
aspectAG = T_Grammar -> Inh_Grammar -> Syn_Grammar
AspectAGDump.wrap_Grammar (Grammar -> T_Grammar
AspectAGDump.sem_Grammar Grammar
grammar2 ) AspectAGDump.Inh_Grammar { options_Inh_Grammar :: Options
AspectAGDump.options_Inh_Grammar = Options
flags'
, agi_Inh_Grammar :: (Set NontermIdent, DataTypes,
Map NontermIdent (Attributes, Attributes))
AspectAGDump.agi_Inh_Grammar = (Set NontermIdent, DataTypes,
Map NontermIdent (Attributes, Attributes))
agi
, ext_Inh_Grammar :: Maybe String
AspectAGDump.ext_Inh_Grammar = Maybe String
ext' }
String -> IO ()
printStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP_Doc -> String
formatErrors forall a b. (a -> b) -> a -> b
$ Syn_Errors -> PP_Doc
PrErr.pp_Syn_Errors Syn_Errors
output6
if Int
additionalErrors forall a. Ord a => a -> a -> Bool
> Int
0
then String -> IO ()
printStr forall a b. (a -> b) -> a -> b
$ String
"\nPlus " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
additionalErrors forall a. [a] -> [a] -> [a]
++ String
" more error" forall a. [a] -> [a] -> [a]
++ forall {a}. (Eq a, Num a) => a -> String
pluralS Int
additionalErrors forall a. [a] -> [a] -> [a]
++
if Int
additionalWarnings forall a. Ord a => a -> a -> Bool
> Int
0
then String
" and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
additionalWarnings forall a. [a] -> [a] -> [a]
++ String
" more warning" forall a. [a] -> [a] -> [a]
++ forall {a}. (Eq a, Num a) => a -> String
pluralS Int
additionalWarnings forall a. [a] -> [a] -> [a]
++ String
".\n"
else String
".\n"
else if Int
additionalWarnings forall a. Ord a => a -> a -> Bool
> Int
0
then String -> IO ()
printStr forall a b. (a -> b) -> a -> b
$ String
"\nPlus " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
additionalWarnings forall a. [a] -> [a] -> [a]
++ String
" more warning" forall a. [a] -> [a] -> [a]
++ forall {a}. (Eq a, Num a) => a -> String
pluralS Int
additionalWarnings forall a. [a] -> [a] -> [a]
++ String
".\n"
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
aoag Options
flags' Bool -> Bool -> Bool
&& Options -> Bool
verbose Options
flags' Bool -> Bool -> Bool
&&
forall a. Maybe a -> Bool
isJust (Syn_Grammar -> Maybe PP_Doc
Pass3b.ads_Syn_Grammar Syn_Grammar
output3b)) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Syn_Grammar -> Maybe PP_Doc
Pass3b.ads_Syn_Grammar Syn_Grammar
output3b)
if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
errorsToStopOn)
then Int -> IO ()
failWith Int
1
else
do
if Options -> Bool
genvisage Options
flags'
then String -> String -> IO ()
writeFile (String
outputfileforall a. [a] -> [a] -> [a]
++String
".visage") (ATerm -> String
writeATerm ATerm
aterm)
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Options -> Bool
genmirage Options
flags'
then String -> ByteString -> IO ()
ByteString.writeFile (String
outputfileforall a. [a] -> [a] -> [a]
++String
".mirage") (forall a. ToJSON a => a -> ByteString
encode Grammar
mirage)
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Options -> Bool
genAttributeList Options
flags'
then String -> AttrMap -> IO ()
writeAttributeList (String
outputfileforall a. [a] -> [a] -> [a]
++String
".attrs") (Syn_Grammar -> AttrMap
Pass1a.allAttributes_Syn_Grammar Syn_Grammar
output1a)
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Options -> Bool
sepSemMods Options
flags'
then do
if Options -> Bool
loag Options
flags Bool -> Bool -> Bool
|| Options -> Bool
kennedyWarren Options
flags'
then if Options -> Bool
ocaml Options
flags'
then forall a. HasCallStack => String -> a
error String
"sepsemmods is not implemented for the ocaml output generation"
else Syn_ExecutionPlan -> IO ()
Pass4b.genIO_Syn_ExecutionPlan Syn_ExecutionPlan
output4b
else Syn_Program -> IO ()
Pass5.genIO_Syn_Program Syn_Program
output5
if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
errorsToStopOn) then Int -> IO ()
failWith Int
1 else forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let doc :: PP_Doc
doc
| Options -> Bool
visitorsOutput Options
flags'
= forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp_braces PP_Doc
importBlocksTxt
, forall a. PP a => a -> PP_Doc
pp_braces PP_Doc
textBlocksDoc
, forall a. PP a => [a] -> PP_Doc
vlist forall a b. (a -> b) -> a -> b
$ Syn_CGrammar -> [PP_Doc]
Pass4a.output_Syn_CGrammar Syn_CGrammar
output4a
]
| Options -> Bool
genAspectAG Options
flags'
= forall a. PP a => [a] -> PP_Doc
vlist [ PP_Doc
AspectAGDump.pragmaAspectAG
, forall a. PP a => a -> PP_Doc
pp String
optionsLine
, forall a. PP a => a -> PP_Doc
pp String
pragmaBlocksTxt
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
70 (String
"-- UUAGC2AspectAG " forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop Int
50 String
banner forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ String
input) forall a. [a] -> [a] -> [a]
++ String
")"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1
then Options -> String -> Maybe String -> String
moduleHeader Options
flags' String
mainName Maybe String
ext'
else Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
mkModuleHeader (Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1) String
mainName String
"" String
"" Bool
False
, forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
, Syn_Grammar -> PP_Doc
AspectAGDump.imp_Syn_Grammar Syn_Grammar
aspectAG
, forall a. PP a => a -> PP_Doc
pp String
"\n\n{-- AspectAG Code --}\n\n"
, Syn_Grammar -> PP_Doc
AspectAGDump.pp_Syn_Grammar Syn_Grammar
aspectAG
, PP_Doc
dataBlocksDoc
, PP_Doc
mainBlocksDoc
, PP_Doc
textBlocksDoc
, if Options -> Bool
dumpgrammar Options
flags'
then forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp String
"{- Dump of AGI"
, forall a. PP a => a -> PP_Doc
pp (forall a. Show a => a -> String
show (Set NontermIdent, DataTypes,
Map NontermIdent (Attributes, Attributes))
agi)
, forall a. PP a => a -> PP_Doc
pp String
"-}"
, forall a. PP a => a -> PP_Doc
pp String
"{- Dump of grammar with default rules"
, Syn_Grammar -> PP_Doc
GrammarDump.pp_Syn_Grammar Syn_Grammar
dump2
, forall a. PP a => a -> PP_Doc
pp String
"-}"
]
else PP_Doc
empty]
| Options -> Bool
loag Options
flags' Bool -> Bool -> Bool
|| Options -> Bool
kennedyWarren Options
flags'
= if Options -> Bool
ocaml Options
flags'
then forall a. PP a => [a] -> PP_Doc
vlist
[ String -> PP_Doc
text String
"(* generated by UUAG from" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
mainFile forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
"*)"
, forall a. PP a => a -> PP_Doc
pp String
pragmaBlocksTxt
, String -> PP_Doc
text String
"(* module imports *)"
, forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
, Syn_ExecutionPlan -> PP_Doc
Pass4c.modules_Syn_ExecutionPlan Syn_ExecutionPlan
output4c
, String -> PP_Doc
text String
""
, String -> PP_Doc
text String
"(* generated data types *)"
, String -> PP_Doc
text String
"module Data__ = struct"
, forall a. PP a => Int -> a -> PP_Doc
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall a. PP a => [a] -> PP_Doc
vlist
[ String -> PP_Doc
text String
"type __generated_by_uuagc__ = Generated_by_uuagc__"
, Syn_ExecutionPlan -> PP_Doc
Pass4c.datas_Syn_ExecutionPlan Syn_ExecutionPlan
output4c
]
, String -> PP_Doc
text String
"end"
, String -> PP_Doc
text String
"open Data__"
, String -> PP_Doc
text String
""
, String -> PP_Doc
text String
"(* embedded data types *)"
, PP_Doc
dataBlocksDoc
, String -> PP_Doc
text String
""
, String -> PP_Doc
text String
"(* embedded utilty functions *)"
, PP_Doc
textBlocksDoc
, String -> PP_Doc
text String
"(* generated evaluationcode *)"
, String -> PP_Doc
text String
"module Code__ = struct"
, forall a. PP a => Int -> a -> PP_Doc
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall a. PP a => [a] -> PP_Doc
vlist
[ String -> PP_Doc
text String
"let rec __generated_by_uuagc__ = Generated_by_uuagc__"
, Syn_ExecutionPlan -> PP_Doc
Pass4c.code_Syn_ExecutionPlan Syn_ExecutionPlan
output4c
, PP_Doc
recBlocksDoc
]
, String -> PP_Doc
text String
"end"
, String -> PP_Doc
text String
"open Code__"
, String -> PP_Doc
text String
""
, String -> PP_Doc
text String
"(* main code *)"
, PP_Doc
mainBlocksDoc
]
else if Options -> Bool
clean Options
flags'
then forall a. PP a => [a] -> PP_Doc
vlist
[ forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1
then Options -> String -> String
Pass4d.cleanIclModuleHeader Options
flags' String
mainName
else Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
Pass4d.mkIclModuleHeader (Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1) String
mainName String
"" String
"" Bool
False
, forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
, PP_Doc
dataBlocksDoc
, forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"from Control.Monad.Identity import :: Identity"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import qualified Control.Monad.Identity as Control.Monad.Identity"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import Control.Monad.Identity"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"from Control.Applicative import lift"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"from Control.Monad import class Monad (..)"
]
, PP_Doc
mainBlocksDoc
, PP_Doc
textBlocksDoc
, PP_Doc
recBlocksDoc
, Syn_ExecutionPlan -> PP_Doc
Pass4d.output_Syn_ExecutionPlan Syn_ExecutionPlan
output4d
, if Options -> Bool
dumpgrammar Options
flags'
then forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp String
"/* Dump of grammar with default rules"
, Syn_Grammar -> PP_Doc
GrammarDump.pp_Syn_Grammar Syn_Grammar
dump2
, forall a. PP a => a -> PP_Doc
pp String
"*/"
]
else PP_Doc
empty]
else forall a. PP a => [a] -> PP_Doc
vlist
[ Options -> PP_Doc
Pass4b.warrenFlagsPP Options
flags'
, forall a. PP a => a -> PP_Doc
pp String
pragmaBlocksTxt
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1
then Options -> String -> Maybe String -> String
moduleHeader Options
flags' String
mainName forall a. Maybe a
Nothing
else Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
mkModuleHeader (Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1) String
mainName String
"" String
"" Bool
False
, forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
, ( if Options -> Bool
tupleAsDummyToken Options
flags'
then PP_Doc
empty
else forall a. PP a => a -> PP_Doc
pp String
"import GHC.Prim"
)
, if Options -> Bool
parallelInvoke Options
flags'
then forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import qualified System.IO.Unsafe(unsafePerformIO)"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import System.IO(IO)"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)"]
else forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import Control.Monad.Identity (Identity)"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import qualified Control.Monad.Identity" ]
, PP_Doc
dataBlocksDoc
, PP_Doc
mainBlocksDoc
, PP_Doc
textBlocksDoc
, PP_Doc
recBlocksDoc
, Syn_ExecutionPlan -> PP_Doc
Pass4b.output_Syn_ExecutionPlan Syn_ExecutionPlan
output4b
, if Options -> Bool
dumpgrammar Options
flags'
then forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp String
"{- Dump of grammar with default rules"
, Syn_Grammar -> PP_Doc
GrammarDump.pp_Syn_Grammar Syn_Grammar
dump2
, forall a. PP a => a -> PP_Doc
pp String
"-}"
]
else PP_Doc
empty]
| Bool
otherwise
= forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => [a] -> PP_Doc
vlist ( if (Options -> Bool
ocaml Options
flags' Bool -> Bool -> Bool
|| Options -> Bool
clean Options
flags')
then []
else [ forall a. PP a => a -> PP_Doc
pp String
optionsLine
, forall a. PP a => a -> PP_Doc
pp String
pragmaBlocksTxt
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
70 (String
"-- UUAGC " forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop Int
50 String
banner forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ String
input) forall a. [a] -> [a] -> [a]
++ String
")"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1
then Options -> String -> Maybe String -> String
moduleHeader Options
flags' String
mainName forall a. Maybe a
Nothing
else Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
mkModuleHeader (Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1) String
mainName String
"" String
"" Bool
False
]
)
, forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
, PP_Doc
dataBlocksDoc
, PP_Doc
mainBlocksDoc
, PP_Doc
textBlocksDoc
, forall a. PP a => [a] -> PP_Doc
vlist forall a b. (a -> b) -> a -> b
$ if (Options -> Bool
ocaml Options
flags')
then Syn_Program -> [PP_Doc]
Pass5a.output_Syn_Program Syn_Program
output5a
else if (Options -> Bool
clean Options
flags')
then Syn_Program -> [PP_Doc]
Pass5b.output_Syn_Program Syn_Program
output5b
else Syn_Program -> [PP_Doc]
Pass5.output_Syn_Program Syn_Program
output5
, if Options -> Bool
dumpgrammar Options
flags'
then forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp String
"{- Dump of grammar without default rules"
, Syn_Grammar -> PP_Doc
GrammarDump.pp_Syn_Grammar Syn_Grammar
dump1
, forall a. PP a => a -> PP_Doc
pp String
"-}"
, forall a. PP a => a -> PP_Doc
pp String
"{- Dump of grammar with default rules"
, Syn_Grammar -> PP_Doc
GrammarDump.pp_Syn_Grammar Syn_Grammar
dump2
, forall a. PP a => a -> PP_Doc
pp String
"-}"
]
else PP_Doc
empty
, if Options -> Bool
dumpcgrammar Options
flags'
then forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp String
"{- Dump of cgrammar"
, Syn_CGrammar -> PP_Doc
CGrammarDump.pp_Syn_CGrammar Syn_CGrammar
dump3
, forall a. PP a => a -> PP_Doc
pp String
"-}"
]
else PP_Doc
empty
]
let docTxt :: String
docTxt = PP_Doc -> Int -> String -> String
disp PP_Doc
doc Int
50000 String
""
String -> String -> IO ()
writeFile String
outputfile String
docTxt
if Options -> Bool
clean Options
flags'
then do let dclDoc :: PP_Doc
dclDoc =
forall a. PP a => [a] -> PP_Doc
vlist
[ forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1
then Options -> String -> Maybe String -> String
Pass4d.cleanDclModuleHeader Options
flags' String
mainName forall a. Maybe a
Nothing
else Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
Pass4d.mkDclModuleHeader (Syn_AG -> Maybe (String, String, String)
Pass1.moduleDecl_Syn_AG Syn_AG
output1) String
mainName String
"" String
"" Bool
False
, forall a. PP a => [a] -> PP_Doc
vlist [ forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"from Control.Monad.Identity import :: Identity"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import qualified Control.Monad.Identity as Control.Monad.Identity"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"import Control.Monad.Identity"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"from Control.Applicative import lift"
, forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ String
"from Control.Monad import class Monad (..)"
]
, Syn_ExecutionPlan -> PP_Doc
Pass4d.output_dcl_Syn_ExecutionPlan Syn_ExecutionPlan
output4d
]
String -> String -> IO ()
writeFile (String -> String -> String
replaceExtension String
outputfile String
".dcl") (PP_Doc -> Int -> String -> String
disp PP_Doc
dclDoc Int
50000 String
"")
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
let nAuto :: Int
nAuto = Syn_Grammar -> Int
Pass3.nAutoRules_Syn_Grammar Syn_Grammar
output3
nExpl :: Int
nExpl = Syn_Grammar -> Int
Pass3.nExplicitRules_Syn_Grammar Syn_Grammar
output3
line' :: String
line' = String
inputfile forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
nAuto forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
nExpl forall a. [a] -> [a] -> [a]
++ String
"\r\n"
case Options -> Maybe String
statsFile Options
flags' of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
f -> String -> String -> IO ()
appendFile String
f String
line'
if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
errorsToStopOn) then Int -> IO ()
failWith Int
1 else forall (m :: * -> *) a. Monad m => a -> m a
return ()
formatErrors :: PP_Doc -> String
formatErrors :: PP_Doc -> String
formatErrors PP_Doc
doc = PP_Doc -> Int -> String -> String
disp PP_Doc
doc Int
5000 String
""
message2error :: Message Token Pos -> Error
message2error :: Message Token Pos -> Error
message2error (Msg Expecting Token
expect Pos
pos Action Token
action) = Pos -> String -> String -> Error
ParserError Pos
pos (forall a. Show a => a -> String
show Expecting Token
expect) String
actionString
where actionString :: String
actionString
= case Action Token
action
of Insert Token
s -> String
"inserting: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Token
s
Delete Token
s -> String
"deleting: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Token
s
Other String
ms -> String
ms
errorsToFront :: Options -> [Error] -> [Error]
errorsToFront :: Options -> Errors -> Errors
errorsToFront Options
flags Errors
mesgs = Errors
errs forall a. [a] -> [a] -> [a]
++ Errors
warnings
where (Errors
errs,Errors
warnings) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Options -> Error -> Bool
PrErr.isError Options
flags) Errors
mesgs
moduleHeader :: Options -> String -> Maybe String -> String
Options
flags String
input Maybe String
export
= case Options -> ModuleHeader
moduleName Options
flags
of Name String
nm -> String -> String
genMod String
nm
ModuleHeader
Default -> String -> String
genMod (String -> String
defaultModuleName String
input)
ModuleHeader
NoName -> String
""
where genMod :: String -> String
genMod String
x = String
"module " forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
genExp Maybe String
export String
x forall a. [a] -> [a] -> [a]
++ String
" where"
genExp :: Maybe String -> String -> String
genExp Maybe String
Nothing String
_ = String
""
genExp (Just String
e) String
x = String
"(module " forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
", module " forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
agiFile :: String -> String
agiFile :: String -> String
agiFile String
name = String -> String -> String
replaceExtension String
name String
"agi"
remAgi :: String -> String
remAgi :: String -> String
remAgi = String -> String
dropExtension
outputFile :: Options -> String -> String
outputFile :: Options -> String -> String
outputFile Options
opts String
name
| Options -> Bool
ocaml Options
opts = String -> String -> String
replaceExtension String
name String
"ml"
| Options -> Bool
clean Options
opts = String -> String -> String
replaceExtension String
name String
"icl"
| Bool
otherwise = String -> String -> String
replaceExtension String
name String
"hs"
defaultModuleName :: String -> String
defaultModuleName :: String -> String
defaultModuleName = String -> String
dropExtension
mkMainName :: String -> Maybe (String, String,String) -> String
mkMainName :: String -> Maybe (String, String, String) -> String
mkMainName String
defaultName Maybe (String, String, String)
Nothing
= String
defaultName
mkMainName String
_ (Just (String
name, String
_, String
_))
= String
name
mkModuleHeader :: Maybe (String,String,String) -> String -> String -> String -> Bool -> String
Maybe (String, String, String)
Nothing String
defaultName String
suffix String
_ Bool
_
= String
"module " forall a. [a] -> [a] -> [a]
++ String
defaultName forall a. [a] -> [a] -> [a]
++ String
suffix forall a. [a] -> [a] -> [a]
++ String
" where"
mkModuleHeader (Just (String
name, String
exports, String
imports)) String
_ String
suffix String
addExports Bool
replaceExports
= String
"module " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
suffix forall a. [a] -> [a] -> [a]
++ String
ex forall a. [a] -> [a] -> [a]
++ String
" where\n" forall a. [a] -> [a] -> [a]
++ String
imports forall a. [a] -> [a] -> [a]
++ String
"\n"
where
ex :: String
ex = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
exports Bool -> Bool -> Bool
|| (Bool
replaceExports Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
addExports)
then String
""
else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
addExports
then String
"(" forall a. [a] -> [a] -> [a]
++ String
exports forall a. [a] -> [a] -> [a]
++ String
")"
else if Bool
replaceExports
then String
"(" forall a. [a] -> [a] -> [a]
++ String
addExports forall a. [a] -> [a] -> [a]
++ String
")"
else String
"(" forall a. [a] -> [a] -> [a]
++ String
exports forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ String
addExports forall a. [a] -> [a] -> [a]
++ String
")"
reportDeps :: Options -> [String] -> IO ()
reportDeps :: Options -> [String] -> IO ()
reportDeps Options
flags [String]
files
= do [String]
deps <- Options -> [String] -> IO [String]
getDeps Options
flags [String]
files
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
deps
getDeps :: Options -> [String] -> IO [String]
getDeps :: Options -> [String] -> IO [String]
getDeps Options
flags [String]
files
= do [([String], [Message Token Pos])]
results <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Options -> [String] -> String -> IO ([String], [Message Token Pos])
depsAG Options
flags (Options -> [String]
searchPath Options
flags)) [String]
files
let ([String]
fs, [Message Token Pos]
mesgs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. ([a], [b]) -> ([a], [b]) -> ([a], [b])
comb ([],[]) [([String], [Message Token Pos])]
results
let errs :: Errors
errs = forall a. Int -> [a] -> [a]
take (forall a. Ord a => a -> a -> a
min Int
1 (Options -> Int
wmaxerrs Options
flags)) (forall a b. (a -> b) -> [a] -> [b]
map Message Token Pos -> Error
message2error [Message Token Pos]
mesgs)
let ppErrs :: Syn_Errors
ppErrs = T_Errors -> Inh_Errors -> Syn_Errors
PrErr.wrap_Errors (Errors -> T_Errors
PrErr.sem_Errors Errors
errs) PrErr.Inh_Errors {options_Inh_Errors :: Options
PrErr.options_Inh_Errors = Options
flags, dups_Inh_Errors :: [String]
PrErr.dups_Inh_Errors = []}
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
errs
then forall (m :: * -> *) a. Monad m => a -> m a
return [String]
fs
else do Handle -> String -> IO ()
hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP_Doc -> String
formatErrors forall a b. (a -> b) -> a -> b
$ Syn_Errors -> PP_Doc
PrErr.pp_Syn_Errors Syn_Errors
ppErrs
Options -> Int -> IO ()
failWithCode Options
flags Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
comb :: ([a],[b]) -> ([a], [b]) -> ([a], [b])
comb :: forall a b. ([a], [b]) -> ([a], [b]) -> ([a], [b])
comb ([a]
fs, [b]
mesgs) ([a]
fsr, [b]
mesgsr)
= ([a]
fs forall a. [a] -> [a] -> [a]
++ [a]
fsr, [b]
mesgs forall a. [a] -> [a] -> [a]
++ [b]
mesgsr)
writeAttributeList :: String -> AttrMap -> IO ()
writeAttributeList :: String -> AttrMap -> IO ()
writeAttributeList String
fileP AttrMap
mp
= String -> String -> IO ()
writeFile String
fileP String
s
where
s :: String
s = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(NontermIdent
x,[(String, [(String, String)])]
y) -> (forall a. Show a => a -> String
show NontermIdent
x, [(String, [(String, String)])]
y)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a b. (a -> b) -> [a] -> [b]
map (\(NontermIdent
x,[(String, String)]
y) -> (forall a. Show a => a -> String
show NontermIdent
x, [(String, String)]
y)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a b. (a -> b) -> [a] -> [b]
map (\(NontermIdent
x,NontermIdent
y) -> (forall a. Show a => a -> String
show NontermIdent
x, forall a. Show a => a -> String
show NontermIdent
y)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList)) forall a b. (a -> b) -> a -> b
$ AttrMap
mp
readIrrefutableMap :: Options -> IO AttrMap
readIrrefutableMap :: Options -> IO AttrMap
readIrrefutableMap Options
flags
= case Options -> Maybe String
forceIrrefutables Options
flags of
Just String
fileP -> do String
s <- String -> IO String
readFile String
fileP
seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
let lists :: [(String,[(String,[(String, String)])])]
lists :: [(String, [(String, [(String, String)])])]
lists = forall a. Read a => String -> a
read String
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (String -> NontermIdent
identifier String
n, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String -> NontermIdent
identifier String
c, forall a. Ord a => [a] -> Set a
Set.fromList [ (String -> NontermIdent
identifier String
fld, String -> NontermIdent
identifier String
attr) | (String
fld,String
attr) <- [(String, String)]
ss ]) | (String
c,[(String, String)]
ss) <- [(String, [(String, String)])]
cs ]) | (String
n,[(String, [(String, String)])]
cs) <- [(String, [(String, [(String, String)])])]
lists ]
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Map.empty