-- Todo: we should make a nicer pipeline. Perhaps use Atze's "compile run" combinators.

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 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 (..)) --marcos


import Options
import Version       (banner)
import Parser        (parseAG, depsAG, parseAGI)
import ErrorMessages (Error(ParserError))
import CommonTypes
import ATermWrite

-- Library version

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."
                 (ExitCode, [String]) -> IO (ExitCode, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1, [])
         else if (Bool -> Bool
not(Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
errs
              then do String -> IO ()
putStrLn String
"One or more errors occured:"
                      (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
errs
                      (ExitCode, [String]) -> IO (ExitCode, [String])
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]
                           (ExitCode, [String]) -> IO (ExitCode, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, [String]
deps)
                   else do Options -> String -> String -> IO ()
compile Options
flags String
fileP ([String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Options -> [String]
outputFiles Options
flags[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++String -> [String]
forall a. a -> [a]
repeat String
"")
                           (ExitCode, [String]) -> IO (ExitCode, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, [])

-- Executable version

uuagcExe :: IO ()
uuagcExe :: IO ()
uuagcExe
 = do [String]
args     <- IO [String]
getArgs
      String
progName <- IO String
getProgName

      let usageheader :: String
usageheader = String
"Usage info:\n " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
progName String -> String -> String
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 (String -> [OptDescr (Options -> Options)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
usageheader [OptDescr (Options -> Options)]
options)
             else if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files Bool -> Bool -> Bool
|| (Bool -> Bool
not(Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
errs
                  then do (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn (String -> [OptDescr (Options -> Options)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
usageheader [OptDescr (Options -> Options)]
options String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
errs)
                          ExitCode -> IO ()
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 (String -> String -> IO ()) -> [String] -> [String] -> IO ()
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
flags[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++String -> [String]
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 = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
input String -> String
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 ) Inh_AG :: Options -> Inh_AG
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                          ) Inh_Grammar :: AttrMap -> String -> Options -> Inh_Grammar
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                          ) Inh_Grammar :: Map NontermIdent ConstructorType -> Options -> Inh_Grammar
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                           ) Inh_Grammar :: Inh_Grammar
PassV.Inh_Grammar  {}
          grammarV :: VisageGrammar
grammarV  = Syn_Grammar -> VisageGrammar
PassV.visage_Syn_Grammar   Syn_Grammar
outputV
          output2a :: Syn_Grammar
output2a  = T_Grammar -> Inh_Grammar -> Syn_Grammar
Pass2a.wrap_Grammar        (Grammar -> T_Grammar
Pass2a.sem_Grammar Grammar
grammar2                          ) Inh_Grammar :: Options -> Inh_Grammar
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                          ) Inh_Grammar :: Options -> Inh_Grammar
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                         ) Inh_Grammar :: Options -> Inh_Grammar
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                         ) Inh_Grammar :: Options -> Inh_Grammar
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)) Inh_CGrammar :: Options -> Inh_CGrammar
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)) Inh_CGrammar :: Options -> Inh_CGrammar
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) Inh_ExecutionPlan :: PP_Doc
-> Map NontermIdent Attributes
-> Map NontermIdent (Map NontermIdent Attributes)
-> PP_Doc
-> String
-> String
-> (String -> String -> String -> Bool -> String)
-> Options
-> String
-> Map NontermIdent Attributes
-> Map BlockInfo PP_Doc
-> PP_Doc
-> Inh_ExecutionPlan
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 (Maybe (String, String, String)
 -> String -> String -> String -> Bool -> String)
-> Maybe (String, String, String)
-> String
-> String
-> String
-> Bool
-> String
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 (Maybe (String, String, String) -> String)
-> Maybe (String, String, String) -> String
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) Inh_ExecutionPlan :: Map NontermIdent Attributes
-> Map NontermIdent (Map NontermIdent Attributes)
-> String
-> String
-> Options
-> Map NontermIdent Attributes
-> Inh_ExecutionPlan
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 (Maybe (String, String, String) -> String)
-> Maybe (String, String, String) -> String
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) Inh_ExecutionPlan :: Map NontermIdent ConstructorType
-> (String -> String -> String -> Bool -> String)
-> (String -> String -> String -> Bool -> String)
-> PP_Doc
-> Map NontermIdent Attributes
-> Map NontermIdent (Map NontermIdent Attributes)
-> PP_Doc
-> String
-> String
-> Options
-> Map NontermIdent Attributes
-> Map BlockInfo PP_Doc
-> PP_Doc
-> Inh_ExecutionPlan
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 (Maybe (String, String, String)
 -> String -> String -> String -> Bool -> String)
-> Maybe (String, String, String)
-> String
-> String
-> String
-> Bool
-> String
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 (Maybe (String, String, String)
 -> String -> String -> String -> Bool -> String)
-> Maybe (String, String, String)
-> String
-> String
-> String
-> Bool
-> String
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 (Maybe (String, String, String) -> String)
-> Maybe (String, String, String) -> String
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)) Inh_Program :: PP_Doc
-> PP_Doc
-> String
-> String
-> (String -> String -> String -> Bool -> String)
-> Options
-> String
-> String
-> Map BlockInfo PP_Doc
-> PP_Doc
-> Inh_Program
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 (Maybe (String, String, String)
 -> String -> String -> String -> Bool -> String)
-> Maybe (String, String, String)
-> String
-> String
-> String
-> Bool
-> String
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 (Maybe (String, String, String) -> String)
-> Maybe (String, String, String) -> String
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)) Inh_Program :: Options -> Map BlockInfo PP_Doc -> Inh_Program
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)) Inh_Program :: PP_Doc
-> PP_Doc
-> String
-> String
-> (String -> String -> String -> Bool -> String)
-> Options
-> String
-> String
-> Map BlockInfo PP_Doc
-> PP_Doc
-> Inh_Program
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 (Maybe (String, String, String)
 -> String -> String -> String -> Bool -> String)
-> Maybe (String, String, String)
-> String
-> String
-> String
-> Bool
-> String
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 (Maybe (String, String, String) -> String)
-> Maybe (String, String, String) -> String
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) Inh_Errors :: [String] -> Options -> Inh_Errors
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

          parseErrorList :: Errors
parseErrorList   = (Message Token Pos -> Error) -> [Message Token Pos] -> Errors
forall a b. (a -> b) -> [a] -> [b]
map Message Token Pos -> Error
message2error ([Message Token Pos]
parseErrors)
          mainErrors :: Errors
mainErrors       = Seq Error -> Errors
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_AG -> Seq Error
Pass1.errors_Syn_AG       Syn_AG
output1
                               Seq Error -> Seq Error -> Seq Error
forall a. Seq a -> Seq a -> Seq a
Seq.>< Syn_Grammar -> Seq Error
Pass1a.errors_Syn_Grammar Syn_Grammar
output1a
                               Seq Error -> Seq Error -> Seq Error
forall a. Seq a -> Seq a -> Seq a
Seq.>< Syn_Grammar -> Seq Error
Pass2.errors_Syn_Grammar  Syn_Grammar
output2
                               Seq Error -> Seq Error -> Seq Error
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 Seq Error -> Errors
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 Seq Error -> Bool
forall a. Seq a -> Bool
Seq.null Seq Error
errs3a
                                          then if Options -> Bool
ocaml Options
flags'
                                               then Seq Error -> Errors
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 Seq Error -> Errors
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_ExecutionPlan -> Seq Error
Pass4d.errors_Syn_ExecutionPlan Syn_ExecutionPlan
output4d )
                                                    else Seq Error -> Errors
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_ExecutionPlan -> Seq Error
Pass4b.errors_Syn_ExecutionPlan Syn_ExecutionPlan
output4b )
                                          else Seq Error -> Errors
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Error
errs3a
                                  else Seq Error -> Errors
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Syn_Grammar -> Seq Error
Pass3.errors_Syn_Grammar  Syn_Grammar
output3
                                                Seq Error -> Seq Error -> Seq Error
forall a. Seq a -> Seq a -> Seq a
Seq.>< Syn_CGrammar -> Seq Error
Pass4.errors_Syn_CGrammar Syn_CGrammar
output4)

          errorList :: Errors
errorList        = if Errors -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
parseErrorList
                             then Errors
mainErrors
                                  Errors -> Errors -> Errors
forall a. [a] -> [a] -> [a]
++ if Errors -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Error -> Bool) -> Errors -> Errors
forall a. (a -> Bool) -> [a] -> [a]
filter (Options -> Error -> Bool
PrErr.isError Options
flags') Errors
mainErrors)
                                     then Errors
furtherErrors
                                     else []
                             else [Errors -> Error
forall a. [a] -> a
head Errors
parseErrorList]

          fatalErrorList :: Errors
fatalErrorList = (Error -> Bool) -> Errors -> Errors
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 = Int -> Errors -> Errors
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) {-SM `Map.unionWith (++)` (Pass3.blocks_Syn_Grammar output3)-}
          (Blocks
pragmaBlocks, Blocks
blocks2)    = (BlockInfo -> [([String], Pos)] -> Bool)
-> Blocks -> (Blocks, Blocks)
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
kBlockKind -> BlockKind -> Bool
forall a. Eq a => a -> a -> Bool
==BlockKind
BlockPragma Bool -> Bool -> Bool
&& Maybe NontermIdent
at Maybe NontermIdent -> Maybe NontermIdent -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe NontermIdent
forall a. Maybe a
Nothing) Blocks
blocks1
          (Blocks
importBlocks, Blocks
textBlocks) = (BlockInfo -> [([String], Pos)] -> Bool)
-> Blocks -> (Blocks, Blocks)
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
kBlockKind -> BlockKind -> Bool
forall a. Eq a => a -> a -> Bool
==BlockKind
BlockImport Bool -> Bool -> Bool
&& Maybe NontermIdent
at Maybe NontermIdent -> Maybe NontermIdent -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe NontermIdent
forall a. Maybe a
Nothing) Blocks
blocks2

          importBlocksTxt :: PP_Doc
importBlocksTxt = String -> [PP_Doc] -> PP_Doc
forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" ([PP_Doc] -> PP_Doc) -> (Blocks -> [PP_Doc]) -> Blocks -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Pos) -> PP_Doc) -> [([String], Pos)] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma ([([String], Pos)] -> [PP_Doc])
-> (Blocks -> [([String], Pos)]) -> Blocks -> [PP_Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[([String], Pos)]] -> [([String], Pos)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[([String], Pos)]] -> [([String], Pos)])
-> (Blocks -> [[([String], Pos)]]) -> Blocks -> [([String], Pos)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [[([String], Pos)]]
forall k a. Map k a -> [a]
Map.elems (Blocks -> PP_Doc) -> Blocks -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Blocks
importBlocks
          textBlocksDoc :: PP_Doc
textBlocksDoc   = String -> [PP_Doc] -> PP_Doc
forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" ([PP_Doc] -> PP_Doc) -> (Blocks -> [PP_Doc]) -> Blocks -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Pos) -> PP_Doc) -> [([String], Pos)] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma ([([String], Pos)] -> [PP_Doc])
-> (Blocks -> [([String], Pos)]) -> Blocks -> [PP_Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([String], Pos)] -> BlockInfo -> Blocks -> [([String], Pos)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (BlockKind
BlockOther, Maybe NontermIdent
forall a. Maybe a
Nothing) (Blocks -> PP_Doc) -> Blocks -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
          mainBlocksDoc :: PP_Doc
mainBlocksDoc   = String -> [PP_Doc] -> PP_Doc
forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" ([PP_Doc] -> PP_Doc) -> (Blocks -> [PP_Doc]) -> Blocks -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Pos) -> PP_Doc) -> [([String], Pos)] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma ([([String], Pos)] -> [PP_Doc])
-> (Blocks -> [([String], Pos)]) -> Blocks -> [PP_Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([String], Pos)] -> BlockInfo -> Blocks -> [([String], Pos)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (BlockKind
BlockMain, Maybe NontermIdent
forall a. Maybe a
Nothing) (Blocks -> PP_Doc) -> Blocks -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
          dataBlocksDoc :: PP_Doc
dataBlocksDoc   = String -> [PP_Doc] -> PP_Doc
forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" ([PP_Doc] -> PP_Doc) -> (Blocks -> [PP_Doc]) -> Blocks -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Pos) -> PP_Doc) -> [([String], Pos)] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma ([([String], Pos)] -> [PP_Doc])
-> (Blocks -> [([String], Pos)]) -> Blocks -> [PP_Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([String], Pos)] -> BlockInfo -> Blocks -> [([String], Pos)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (BlockKind
BlockData, Maybe NontermIdent
forall a. Maybe a
Nothing) (Blocks -> PP_Doc) -> Blocks -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
          recBlocksDoc :: PP_Doc
recBlocksDoc    = String -> [PP_Doc] -> PP_Doc
forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" ([PP_Doc] -> PP_Doc) -> (Blocks -> [PP_Doc]) -> Blocks -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Pos) -> PP_Doc) -> [([String], Pos)] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma ([([String], Pos)] -> [PP_Doc])
-> (Blocks -> [([String], Pos)]) -> Blocks -> [PP_Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([String], Pos)] -> BlockInfo -> Blocks -> [([String], Pos)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (BlockKind
BlockRec, Maybe NontermIdent
forall a. Maybe a
Nothing) (Blocks -> PP_Doc) -> Blocks -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks
          pragmaBlocksTxt :: String
pragmaBlocksTxt = [String] -> String
unlines ([String] -> String) -> (Blocks -> [String]) -> Blocks -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> (Blocks -> [[String]]) -> Blocks -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Pos) -> [String]) -> [([String], Pos)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> [String]
forall a b. (a, b) -> a
fst  ([([String], Pos)] -> [[String]])
-> (Blocks -> [([String], Pos)]) -> Blocks -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[([String], Pos)]] -> [([String], Pos)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[([String], Pos)]] -> [([String], Pos)])
-> (Blocks -> [[([String], Pos)]]) -> Blocks -> [([String], Pos)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [[([String], Pos)]]
forall k a. Map k a -> [a]
Map.elems (Blocks -> String) -> Blocks -> String
forall a b. (a -> b) -> a -> b
$ Blocks
pragmaBlocks
          textBlockMap :: Map BlockInfo PP_Doc
textBlockMap    = ([([String], Pos)] -> PP_Doc) -> Blocks -> Map BlockInfo PP_Doc
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (String -> [PP_Doc] -> PP_Doc
forall a b. (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep String
"" ([PP_Doc] -> PP_Doc)
-> ([([String], Pos)] -> [PP_Doc]) -> [([String], Pos)] -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Pos) -> PP_Doc) -> [([String], Pos)] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([String], Pos) -> PP_Doc
addLocationPragma) (Blocks -> Map BlockInfo PP_Doc)
-> (Blocks -> Blocks) -> Blocks -> Map BlockInfo PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockInfo -> [([String], Pos)] -> Bool) -> Blocks -> Blocks
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(BlockKind
_, Maybe NontermIdent
at) [([String], Pos)]
_ -> Maybe NontermIdent
at Maybe NontermIdent -> Maybe NontermIdent -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe NontermIdent
forall a. Maybe a
Nothing) (Blocks -> Map BlockInfo PP_Doc) -> Blocks -> Map BlockInfo PP_Doc
forall a b. (a -> b) -> a -> b
$ Blocks
textBlocks

          outputfile :: String
outputfile = if String -> Bool
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 | String -> Bool
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 (String -> String) -> String -> String
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' (Pos -> Int
forall p. Position p => p -> Int
line Pos
p) (Pos -> String
forall p. Position p => p -> String
file Pos
p) PP_Doc -> PP_Doc -> PP_Doc
forall a b. (PP a, PP b) => a -> b -> PP_Doc
>-< [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist ((String -> PP_Doc) -> [String] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp [String]
strs)
                PP_Doc -> PP_Doc -> PP_Doc
forall a b. (PP a, PP b) => a -> b -> PP_Doc
>-< (Int -> PP_Doc) -> PP_Doc
forall a. PP a => (Int -> a) -> PP_Doc
ppWithLineNr (\Int
l -> Options -> Int -> String -> PP_Doc
ppLinePragma Options
flags' (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
outputfile)
            | Bool
otherwise = [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist ((String -> PP_Doc) -> [String] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp [String]
strs)

          optionsGHC :: [String]
optionsGHC = Bool -> String -> [String]
forall a. Bool -> a -> [a]
option (Options -> Bool
unbox Options
flags') String
"-fglasgow-exts" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Bool -> String -> [String]
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 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optionsGHC = String
""
                      | Bool
otherwise       = String
"{-# OPTIONS_GHC " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
optionsGHC String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" #-}"

          nrOfErrorsToReport :: Int
nrOfErrorsToReport = Errors -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Errors -> Int) -> Errors -> Int
forall a b. (a -> b) -> a -> b
$ (Error -> Bool) -> Errors -> Errors
forall a. (a -> Bool) -> [a] -> [a]
filter (Options -> Error -> Bool
PrErr.isError Options
flags') Errors
errorsToReport
          nrOfWarningsToReport :: Int
nrOfWarningsToReport = Errors -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Errors -> Int) -> Errors -> Int
forall a b. (a -> b) -> a -> b
$ (Error -> Bool) -> Errors -> Errors
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Error -> Bool) -> Error -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Options -> Error -> Bool
PrErr.isError Options
flags')) Errors
errorsToReport
          totalNrOfErrors :: Int
totalNrOfErrors = Errors -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Errors -> Int) -> Errors -> Int
forall a b. (a -> b) -> a -> b
$ (Error -> Bool) -> Errors -> Errors
forall a. (a -> Bool) -> [a] -> [a]
filter (Options -> Error -> Bool
PrErr.isError Options
flags') Errors
allErrors
          totalNrOfWarnings :: Int
totalNrOfWarnings = Errors -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Errors -> Int) -> Errors -> Int
forall a b. (a -> b) -> a -> b
$ (Error -> Bool) -> Errors -> Errors
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Error -> Bool) -> Error -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Options -> Error -> Bool
PrErr.isError Options
flags')) Errors
allErrors
          additionalErrors :: Int
additionalErrors = Int
totalNrOfErrors Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nrOfErrorsToReport
          additionalWarnings :: Int
additionalWarnings = Int
totalNrOfWarnings Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nrOfWarningsToReport
          pluralS :: a -> String
pluralS a
n = if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then String
"" else String
"s"

      (AG
outAgi, Maybe String
ext) <-  --marcos

                     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 (AG, Maybe String) -> IO (AG, Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (AG
forall a. HasCallStack => a
undefined, Maybe String
forall a. HasCallStack => a
undefined)

      let ext' :: Maybe String
ext'      = (String -> String) -> Maybe String -> Maybe String
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 ) Inh_AG :: Options -> Inh_AG
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  ) Inh_Grammar :: (Set NontermIdent, DataTypes,
 Map NontermIdent (Attributes, Attributes))
-> Maybe String -> Options -> Inh_Grammar
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' } --marcos


      String -> IO ()
printStr (String -> IO ()) -> (PP_Doc -> String) -> PP_Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP_Doc -> String
formatErrors (PP_Doc -> IO ()) -> PP_Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Syn_Errors -> PP_Doc
PrErr.pp_Syn_Errors Syn_Errors
output6

      if Int
additionalErrors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
       then String -> IO ()
printStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\nPlus " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
additionalErrors String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" more error" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Eq a, Num a) => a -> String
pluralS Int
additionalErrors String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     if Int
additionalWarnings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                     then String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
additionalWarnings String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" more warning" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Eq a, Num a) => a -> String
pluralS Int
additionalWarnings String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".\n"
                     else String
".\n"
       else if Int
additionalWarnings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then String -> IO ()
printStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\nPlus " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
additionalWarnings String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" more warning" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Eq a, Num a) => a -> String
pluralS Int
additionalWarnings String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".\n"
            else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      -- show fake dependencies when found with --aoag

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
aoag Options
flags' Bool -> Bool -> Bool
&& Options -> Bool
verbose Options
flags' Bool -> Bool -> Bool
&& 
            Maybe PP_Doc -> Bool
forall a. Maybe a -> Bool
isJust (Syn_Grammar -> Maybe PP_Doc
Pass3b.ads_Syn_Grammar Syn_Grammar
output3b)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
putStrLn (PP_Doc -> String
forall a. Show a => a -> String
show (PP_Doc -> String) -> PP_Doc -> String
forall a b. (a -> b) -> a -> b
$ Maybe PP_Doc -> PP_Doc
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PP_Doc -> PP_Doc) -> Maybe PP_Doc -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Syn_Grammar -> Maybe PP_Doc
Pass3b.ads_Syn_Grammar Syn_Grammar
output3b)

      if Bool -> Bool
not (Errors -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
errorsToStopOn)  -- note: this may already run quite a part of the compilation...

       then Int -> IO ()
failWith Int
1
       else
        do
           if Options -> Bool
genvisage Options
flags'
            then String -> String -> IO ()
writeFile (String
outputfileString -> String -> String
forall a. [a] -> [a] -> [a]
++String
".visage") (ATerm -> String
writeATerm ATerm
aterm)
            else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

           if Options -> Bool
genAttributeList Options
flags'
            then String -> AttrMap -> IO ()
writeAttributeList (String
outputfileString -> String -> String
forall a. [a] -> [a] -> [a]
++String
".attrs") (Syn_Grammar -> AttrMap
Pass1a.allAttributes_Syn_Grammar Syn_Grammar
output1a)
            else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

           if Options -> Bool
sepSemMods Options
flags'
            then do -- alternative module gen

                    if Options -> Bool
loag Options
flags Bool -> Bool -> Bool
|| Options -> Bool
kennedyWarren Options
flags'
                      then if Options -> Bool
ocaml Options
flags' 
                           then String -> IO ()
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 (Errors -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
errorsToStopOn) then Int -> IO ()
failWith Int
1 else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else do -- conventional module gen

                    let doc :: PP_Doc
doc
                         | Options -> Bool
visitorsOutput Options
flags'
                            = [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ PP_Doc -> PP_Doc
forall a. PP a => a -> PP_Doc
pp_braces PP_Doc
importBlocksTxt
                                    , PP_Doc -> PP_Doc
forall a. PP a => a -> PP_Doc
pp_braces PP_Doc
textBlocksDoc
                                    , [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist ([PP_Doc] -> PP_Doc) -> [PP_Doc] -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Syn_CGrammar -> [PP_Doc]
Pass4a.output_Syn_CGrammar Syn_CGrammar
output4a
                                    ]
                         -- marcos AspectAG gen

                         | Options -> Bool
genAspectAG Options
flags'
                            = [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ PP_Doc
AspectAGDump.pragmaAspectAG
                                    , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
optionsLine
                                    , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
pragmaBlocksTxt
                                    , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
70 (String
"-- UUAGC2AspectAG " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
50 String
banner String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
input) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                                    , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ if Maybe (String, String, String) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (String, String, String) -> Bool)
-> Maybe (String, String, String) -> Bool
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
                                    , PP_Doc -> PP_Doc
forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
                                    , Syn_Grammar -> PP_Doc
AspectAGDump.imp_Syn_Grammar Syn_Grammar
aspectAG
                                    , String -> PP_Doc
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 [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
"{- Dump of AGI"
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp ((Set NontermIdent, DataTypes,
 Map NontermIdent (Attributes, Attributes))
-> String
forall a. Show a => a -> String
show (Set NontermIdent, DataTypes,
 Map NontermIdent (Attributes, Attributes))
agi)
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
"-}"
                                                 , String -> PP_Doc
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
                                                 , String -> PP_Doc
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 [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist
                                    [ String -> PP_Doc
text String
"(* generated by UUAG from" PP_Doc -> PP_Doc -> PP_Doc
forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
mainFile String -> String -> PP_Doc
forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
"*)"
                                    , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
pragmaBlocksTxt
                                    , String -> PP_Doc
text String
"(* module imports *)"
                                    , PP_Doc -> PP_Doc
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"
                                    , Int -> PP_Doc -> PP_Doc
forall a. PP a => Int -> a -> PP_Doc
indent Int
2 (PP_Doc -> PP_Doc) -> PP_Doc -> PP_Doc
forall a b. (a -> b) -> a -> b
$ [PP_Doc] -> PP_Doc
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"
                                    , Int -> PP_Doc -> PP_Doc
forall a. PP a => Int -> a -> PP_Doc
indent Int
2 (PP_Doc -> PP_Doc) -> PP_Doc -> PP_Doc
forall a b. (a -> b) -> a -> b
$ [PP_Doc] -> PP_Doc
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 [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist
                                    [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ if Maybe (String, String, String) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (String, String, String) -> Bool)
-> Maybe (String, String, String) -> Bool
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
                                    , PP_Doc -> PP_Doc
forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
                                    , PP_Doc
dataBlocksDoc
                                    , [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"from Control.Monad.Identity import :: Identity"
                                            , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"import qualified Control.Monad.Identity as Control.Monad.Identity"
                                            , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"import Control.Monad.Identity"
                                            , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"from Control.Applicative import lift"
                                            , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"from Control.Monad import class Monad (..)"
                                            ]
                                    , PP_Doc
mainBlocksDoc
                                    , PP_Doc
textBlocksDoc
                                    , PP_Doc
recBlocksDoc
                                    --, pp $ "{-"

                                    --, Pass3a.depgraphs_Syn_Grammar output3a

                                    --, Pass3a.visitgraph_Syn_Grammar output3a

                                    --, pp $ "-}"

                                    , Syn_ExecutionPlan -> PP_Doc
Pass4d.output_Syn_ExecutionPlan Syn_ExecutionPlan
output4d
                                    , if Options -> Bool
dumpgrammar Options
flags'
                                      then [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
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
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
"*/"
                                                 ]
                                      else PP_Doc
empty]

                                   else [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist
                                    [ Options -> PP_Doc
Pass4b.warrenFlagsPP Options
flags'
                                    , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
pragmaBlocksTxt
                                    , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ if Maybe (String, String, String) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (String, String, String) -> Bool)
-> Maybe (String, String, String) -> Bool
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
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
                                    , PP_Doc -> PP_Doc
forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
                                    , ( if Options -> Bool
tupleAsDummyToken Options
flags'
                                          then PP_Doc
empty
                                          else String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
"import GHC.Prim"  -- need it to pass State#

                                      )
                                    , if Options -> Bool
parallelInvoke Options
flags'
                                      then [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"import qualified System.IO.Unsafe(unsafePerformIO)"
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"import System.IO(IO)"
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)"]
                                      else [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"import Control.Monad.Identity (Identity)"
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
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
                                    --, pp $ "{-"

                                    --, Pass3a.depgraphs_Syn_Grammar output3a

                                    --, Pass3a.visitgraph_Syn_Grammar output3a

                                    --, pp $ "-}"

                                    , Syn_ExecutionPlan -> PP_Doc
Pass4b.output_Syn_ExecutionPlan Syn_ExecutionPlan
output4b
                                    , if Options -> Bool
dumpgrammar Options
flags'
                                      then [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
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
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
"-}"
                                                 ]
                                      else PP_Doc
empty]
                         | Bool
otherwise
                            = [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist ( if (Options -> Bool
ocaml Options
flags' Bool -> Bool -> Bool
|| Options -> Bool
clean Options
flags')
                                              then []
                                              else [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
optionsLine
                                                   , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
pragmaBlocksTxt
                                                   , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
70 (String
"-- UUAGC " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
50 String
banner String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
input) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                                                   , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ if Maybe (String, String, String) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (String, String, String) -> Bool)
-> Maybe (String, String, String) -> Bool
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
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
                                                   ]
                                            )
                                    , PP_Doc -> PP_Doc
forall a. PP a => a -> PP_Doc
pp PP_Doc
importBlocksTxt
                                    , PP_Doc
dataBlocksDoc
                                    , PP_Doc
mainBlocksDoc
                                    , PP_Doc
textBlocksDoc
                                    , [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist ([PP_Doc] -> PP_Doc) -> [PP_Doc] -> PP_Doc
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 [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
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
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
"-}"
                                                 , String -> PP_Doc
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
                                                 , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
"-}"
                                                 ]
                                      else PP_Doc
empty
                                    , if Options -> Bool
dumpcgrammar Options
flags'
                                      then [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp String
"{- Dump of cgrammar"
                                                 , Syn_CGrammar -> PP_Doc
CGrammarDump.pp_Syn_CGrammar Syn_CGrammar
dump3
                                                 , String -> PP_Doc
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

                    -- HACK: write Clean DCL file

                    if Options -> Bool
clean Options
flags'
                      then do let dclDoc :: PP_Doc
dclDoc =
                                    [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist
                                    [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ if Maybe (String, String, String) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (String, String, String) -> Bool)
-> Maybe (String, String, String) -> Bool
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 Maybe String
forall a. Maybe a
Nothing -- TODO: What should be there instead of 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
                                    , [PP_Doc] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
vlist [ String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"from Control.Monad.Identity import :: Identity"
                                            , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"import qualified Control.Monad.Identity as Control.Monad.Identity"
                                            , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"import Control.Monad.Identity"
                                            , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
forall a b. (a -> b) -> a -> b
$ String
"from Control.Applicative import lift"
                                            , String -> PP_Doc
forall a. PP a => a -> PP_Doc
pp (String -> PP_Doc) -> String -> PP_Doc
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 () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                    -- HACK: write statistics

                    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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nAuto String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nExpl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\r\n"
                    case Options -> Maybe String
statsFile Options
flags' of
                      Maybe String
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      Just String
f  -> String -> String -> IO ()
appendFile String
f String
line'
                    if Bool -> Bool
not (Errors -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
errorsToStopOn) then Int -> IO ()
failWith Int
1 else () -> IO ()
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 (Expecting Token -> String
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: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Token -> String
forall a. Show a => a -> String
show Token
s

              Delete Token
s -> String
"deleting: "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Token -> String
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 Errors -> Errors -> Errors
forall a. [a] -> [a] -> [a]
++ Errors
warnings
  where (Errors
errs,Errors
warnings) = (Error -> Bool) -> Errors -> (Errors, Errors)
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Options -> Error -> Bool
PrErr.isError Options
flags) Errors
mesgs

moduleHeader :: Options -> String -> Maybe String -> String
moduleHeader :: Options -> String -> Maybe String -> String
moduleHeader 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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
genExp Maybe String
export String
x String -> String -> String
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

--marcos

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
mkModuleHeader :: Maybe (String, String, String)
-> String -> String -> String -> Bool -> String
mkModuleHeader Maybe (String, String, String)
Nothing String
defaultName String
suffix String
_ Bool
_
  = String
"module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
defaultName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" where"
mkModuleHeader (Just (String
name, String
exports, String
imports)) String
_ String
suffix String
addExports Bool
replaceExports
  = String
"module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" where\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
imports String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
  where
    ex :: String
ex  = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
exports Bool -> Bool -> Bool
|| (Bool
replaceExports Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
addExports)
          then String
""
          else if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
addExports
               then String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exports String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
               else if Bool
replaceExports
                    then String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
addExports String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                    else String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exports String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
addExports String -> String -> String
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
       (String -> IO ()) -> [String] -> IO ()
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 <- (String -> IO ([String], [Message Token Pos]))
-> [String] -> IO [([String], [Message Token Pos])]
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) = (([String], [Message Token Pos])
 -> ([String], [Message Token Pos])
 -> ([String], [Message Token Pos]))
-> ([String], [Message Token Pos])
-> [([String], [Message Token Pos])]
-> ([String], [Message Token Pos])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([String], [Message Token Pos])
-> ([String], [Message Token Pos])
-> ([String], [Message Token Pos])
forall a b. ([a], [b]) -> ([a], [b]) -> ([a], [b])
comb ([],[]) [([String], [Message Token Pos])]
results
       let errs :: Errors
errs = Int -> Errors -> Errors
forall a. Int -> [a] -> [a]
take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1 (Options -> Int
wmaxerrs Options
flags)) ((Message Token Pos -> Error) -> [Message Token Pos] -> Errors
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) Inh_Errors :: [String] -> Options -> Inh_Errors
PrErr.Inh_Errors {options_Inh_Errors :: Options
PrErr.options_Inh_Errors = Options
flags, dups_Inh_Errors :: [String]
PrErr.dups_Inh_Errors = []}
       if Errors -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Errors
errs
        then [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
fs
        else do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (PP_Doc -> String) -> PP_Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP_Doc -> String
formatErrors (PP_Doc -> IO ()) -> PP_Doc -> IO ()
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
                [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    comb :: ([a],[b]) -> ([a], [b]) -> ([a], [b])
    comb :: ([a], [b]) -> ([a], [b]) -> ([a], [b])
comb ([a]
fs, [b]
mesgs) ([a]
fsr, [b]
mesgsr)
      = ([a]
fs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
fsr, [b]
mesgs [b] -> [b] -> [b]
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 = [(String, [(String, [(String, String)])])] -> String
forall a. Show a => a -> String
show ([(String, [(String, [(String, String)])])] -> String)
-> [(String, [(String, [(String, String)])])] -> String
forall a b. (a -> b) -> a -> b
$ ((NontermIdent, [(String, [(String, String)])])
 -> (String, [(String, [(String, String)])]))
-> [(NontermIdent, [(String, [(String, String)])])]
-> [(String, [(String, [(String, String)])])]
forall a b. (a -> b) -> [a] -> [b]
map (\(NontermIdent
x,[(String, [(String, String)])]
y) -> (NontermIdent -> String
forall a. Show a => a -> String
show NontermIdent
x, [(String, [(String, String)])]
y)) ([(NontermIdent, [(String, [(String, String)])])]
 -> [(String, [(String, [(String, String)])])])
-> [(NontermIdent, [(String, [(String, String)])])]
-> [(String, [(String, [(String, String)])])]
forall a b. (a -> b) -> a -> b
$ Map NontermIdent [(String, [(String, String)])]
-> [(NontermIdent, [(String, [(String, String)])])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map NontermIdent [(String, [(String, String)])]
 -> [(NontermIdent, [(String, [(String, String)])])])
-> Map NontermIdent [(String, [(String, String)])]
-> [(NontermIdent, [(String, [(String, String)])])]
forall a b. (a -> b) -> a -> b
$ (Map NontermIdent (Set (NontermIdent, NontermIdent))
 -> [(String, [(String, String)])])
-> AttrMap -> Map NontermIdent [(String, [(String, String)])]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (((NontermIdent, [(String, String)])
 -> (String, [(String, String)]))
-> [(NontermIdent, [(String, String)])]
-> [(String, [(String, String)])]
forall a b. (a -> b) -> [a] -> [b]
map (\(NontermIdent
x,[(String, String)]
y) -> (NontermIdent -> String
forall a. Show a => a -> String
show NontermIdent
x, [(String, String)]
y)) ([(NontermIdent, [(String, String)])]
 -> [(String, [(String, String)])])
-> (Map NontermIdent (Set (NontermIdent, NontermIdent))
    -> [(NontermIdent, [(String, String)])])
-> Map NontermIdent (Set (NontermIdent, NontermIdent))
-> [(String, [(String, String)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NontermIdent [(String, String)]
-> [(NontermIdent, [(String, String)])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map NontermIdent [(String, String)]
 -> [(NontermIdent, [(String, String)])])
-> (Map NontermIdent (Set (NontermIdent, NontermIdent))
    -> Map NontermIdent [(String, String)])
-> Map NontermIdent (Set (NontermIdent, NontermIdent))
-> [(NontermIdent, [(String, String)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (NontermIdent, NontermIdent) -> [(String, String)])
-> Map NontermIdent (Set (NontermIdent, NontermIdent))
-> Map NontermIdent [(String, String)]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (((NontermIdent, NontermIdent) -> (String, String))
-> [(NontermIdent, NontermIdent)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(NontermIdent
x,NontermIdent
y) -> (NontermIdent -> String
forall a. Show a => a -> String
show NontermIdent
x, NontermIdent -> String
forall a. Show a => a -> String
show NontermIdent
y)) ([(NontermIdent, NontermIdent)] -> [(String, String)])
-> (Set (NontermIdent, NontermIdent)
    -> [(NontermIdent, NontermIdent)])
-> Set (NontermIdent, NontermIdent)
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (NontermIdent, NontermIdent) -> [(NontermIdent, NontermIdent)]
forall a. Set a -> [a]
Set.toList)) (AttrMap -> Map NontermIdent [(String, [(String, String)])])
-> AttrMap -> Map NontermIdent [(String, [(String, String)])]
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
                       Int -> IO () -> IO ()
seq (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                       let lists :: [(String,[(String,[(String, String)])])]
                           lists :: [(String, [(String, [(String, String)])])]
lists = String -> [(String, [(String, [(String, String)])])]
forall a. Read a => String -> a
read String
s
                       AttrMap -> IO AttrMap
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrMap -> IO AttrMap) -> AttrMap -> IO AttrMap
forall a b. (a -> b) -> a -> b
$ [(NontermIdent,
  Map NontermIdent (Set (NontermIdent, NontermIdent)))]
-> AttrMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (String -> NontermIdent
identifier String
n, [(NontermIdent, Set (NontermIdent, NontermIdent))]
-> Map NontermIdent (Set (NontermIdent, NontermIdent))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String -> NontermIdent
identifier String
c, [(NontermIdent, NontermIdent)] -> Set (NontermIdent, NontermIdent)
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   -> AttrMap -> IO AttrMap
forall (m :: * -> *) a. Monad m => a -> m a
return AttrMap
forall k a. Map k a
Map.empty