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

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

-- 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."
                 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, [])

-- 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 " 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) {-SM `Map.unionWith (++)` (Pass3.blocks_Syn_Grammar output3)-}
          (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) <-  --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 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' } --marcos

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

      -- show fake dependencies when found with --aoag
      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)  -- 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
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 -- 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 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 -- conventional module gen
                    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
                                    ]
                         -- marcos AspectAG gen
                         | 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
                                    --, 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 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"  -- need it to pass State#
                                      )
                                    , 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
                                    --, 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 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

                    -- HACK: write Clean DCL file
                    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 -- 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
                                    , 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 ()

                    -- 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 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
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 " 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
")"

--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 " 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