-- UUAGC 0.9.5 (PrintCode.ag) module PrintCode where import Char (isAlphaNum) import Pretty import Code import Patterns import Options import CommonTypes (attrname, _LOC, getName, nullIdent) import Data.List(intersperse) import System.IO import System.Directory import Pretty import Patterns import Data.List(partition) import Data.Set(Set) import qualified UU.DData.Set as Set import Data.Map(Map) import qualified Data.Map as Map -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) type PP_Docs = [PP_Doc] ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqH = ppMultiSeq' (>#<) ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqV = ppMultiSeq' (>-<) ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeq' next strictArgs expr = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs reallySimple :: String -> Bool reallySimple = and . map (\x -> isAlphaNum x || x=='_') ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps ppTuple False pps = "(" >|< pp_block " " ")" "," pps ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps locname' n = "_loc_" ++ getName n renderDocs :: [PP_Doc] -> String renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs = do bExists <- doesFileExist path if bExists then do input <- readFile path seq (length input) (return ()) if input /= output then dumpIt else return () else dumpIt where output = renderDocs docs dumpIt = writeFile path output -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not -- inh The inherited attributes. -- If there are none, no unboxing can take place, -- because in that case the semantic function (a top-level identifier) would have an unboxed type. -- Of course we can't have an unboxed 1-tuple mkTupleExpr :: Bool -> Bool -> Exprs -> Expr mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs | otherwise = UnboxedTupleExpr exprs mkTupleType :: Bool -> Bool -> Types -> Type mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps | otherwise = UnboxedTupleType tps mkTupleLhs :: Bool -> Bool -> [String] -> Lhs mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps | otherwise = UnboxedTupleLhs comps -- CaseAlt ----------------------------------------------------- {- visit 0: inherited attributes: nested : Bool options : Options outputfile : String synthesized attribute: pps : PP_Docs alternatives: alternative CaseAlt: child left : Lhs child expr : Expr -} -- cata sem_CaseAlt :: CaseAlt -> T_CaseAlt sem_CaseAlt (CaseAlt _left _expr) = (sem_CaseAlt_CaseAlt (sem_Lhs _left) (sem_Expr _expr)) -- semantic domain newtype T_CaseAlt = T_CaseAlt (Bool -> Options -> String -> ( PP_Docs)) data Inh_CaseAlt = Inh_CaseAlt {nested_Inh_CaseAlt :: Bool,options_Inh_CaseAlt :: Options,outputfile_Inh_CaseAlt :: String} data Syn_CaseAlt = Syn_CaseAlt {pps_Syn_CaseAlt :: PP_Docs} wrap_CaseAlt (T_CaseAlt sem) (Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) = (let ( _lhsOpps) = (sem _lhsInested _lhsIoptions _lhsIoutputfile) in (Syn_CaseAlt _lhsOpps)) sem_CaseAlt_CaseAlt :: T_Lhs -> T_Expr -> T_CaseAlt sem_CaseAlt_CaseAlt (T_Lhs left_) (T_Expr expr_) = (T_CaseAlt (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpps :: PP_Docs _leftOisDeclOfLet :: Bool _leftOnested :: Bool _leftOoptions :: Options _leftOoutputfile :: String _exprOnested :: Bool _exprOoptions :: Options _exprOoutputfile :: String _leftIpp :: PP_Doc _exprIpp :: PP_Doc -- "PrintCode.ag"(line 150, column 16) _lhsOpps = ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] -- "PrintCode.ag"(line 326, column 7) _leftOisDeclOfLet = False -- copy rule (down) _leftOnested = _lhsInested -- copy rule (down) _leftOoptions = _lhsIoptions -- copy rule (down) _leftOoutputfile = _lhsIoutputfile -- copy rule (down) _exprOnested = _lhsInested -- copy rule (down) _exprOoptions = _lhsIoptions -- copy rule (down) _exprOoutputfile = _lhsIoutputfile ( _leftIpp) = (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) ( _exprIpp) = (expr_ _exprOnested _exprOoptions _exprOoutputfile) in ( _lhsOpps)))) -- CaseAlts ---------------------------------------------------- {- visit 0: inherited attributes: nested : Bool options : Options outputfile : String synthesized attribute: pps : PP_Docs alternatives: alternative Cons: child hd : CaseAlt child tl : CaseAlts alternative Nil: -} -- cata sem_CaseAlts :: CaseAlts -> T_CaseAlts sem_CaseAlts list = (Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list)) -- semantic domain newtype T_CaseAlts = T_CaseAlts (Bool -> Options -> String -> ( PP_Docs)) data Inh_CaseAlts = Inh_CaseAlts {nested_Inh_CaseAlts :: Bool,options_Inh_CaseAlts :: Options,outputfile_Inh_CaseAlts :: String} data Syn_CaseAlts = Syn_CaseAlts {pps_Syn_CaseAlts :: PP_Docs} wrap_CaseAlts (T_CaseAlts sem) (Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile) = (let ( _lhsOpps) = (sem _lhsInested _lhsIoptions _lhsIoutputfile) in (Syn_CaseAlts _lhsOpps)) sem_CaseAlts_Cons :: T_CaseAlt -> T_CaseAlts -> T_CaseAlts sem_CaseAlts_Cons (T_CaseAlt hd_) (T_CaseAlts tl_) = (T_CaseAlts (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpps :: PP_Docs _hdOnested :: Bool _hdOoptions :: Options _hdOoutputfile :: String _tlOnested :: Bool _tlOoptions :: Options _tlOoutputfile :: String _hdIpps :: PP_Docs _tlIpps :: PP_Docs -- "PrintCode.ag"(line 59, column 10) _lhsOpps = _hdIpps ++ _tlIpps -- copy rule (down) _hdOnested = _lhsInested -- copy rule (down) _hdOoptions = _lhsIoptions -- copy rule (down) _hdOoutputfile = _lhsIoutputfile -- copy rule (down) _tlOnested = _lhsInested -- copy rule (down) _tlOoptions = _lhsIoptions -- copy rule (down) _tlOoutputfile = _lhsIoutputfile ( _hdIpps) = (hd_ _hdOnested _hdOoptions _hdOoutputfile) ( _tlIpps) = (tl_ _tlOnested _tlOoptions _tlOoutputfile) in ( _lhsOpps)))) sem_CaseAlts_Nil :: T_CaseAlts sem_CaseAlts_Nil = (T_CaseAlts (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpps :: PP_Docs -- "PrintCode.ag"(line 60, column 10) _lhsOpps = [] in ( _lhsOpps)))) -- Chunk ------------------------------------------------------- {- visit 0: inherited attributes: importBlocks : PP_Doc isDeclOfLet : Bool mainFile : String mainName : String moduleHeader : String -> String -> String -> Bool -> String nested : Bool options : Options optionsLine : String pragmaBlocks : String textBlocks : PP_Doc synthesized attributes: appendCommon : [[PP_Doc]] appendMain : [[PP_Doc]] genSems : IO () imports : [String] pps : PP_Docs alternatives: alternative Chunk: child name : {String} child comment : Decl child info : Decls child dataDef : Decls child cataFun : Decls child semDom : Decls child semWrapper : Decls child semFunctions : Decls child semNames : {[String]} visit 0: local outputfile : _ local exports : _ -} -- cata sem_Chunk :: Chunk -> T_Chunk sem_Chunk (Chunk _name _comment _info _dataDef _cataFun _semDom _semWrapper _semFunctions _semNames) = (sem_Chunk_Chunk _name (sem_Decl _comment) (sem_Decls _info) (sem_Decls _dataDef) (sem_Decls _cataFun) (sem_Decls _semDom) (sem_Decls _semWrapper) (sem_Decls _semFunctions) _semNames) -- semantic domain newtype T_Chunk = T_Chunk (PP_Doc -> Bool -> String -> String -> (String -> String -> String -> Bool -> String) -> Bool -> Options -> String -> String -> PP_Doc -> ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs)) data Inh_Chunk = Inh_Chunk {importBlocks_Inh_Chunk :: PP_Doc,isDeclOfLet_Inh_Chunk :: Bool,mainFile_Inh_Chunk :: String,mainName_Inh_Chunk :: String,moduleHeader_Inh_Chunk :: String -> String -> String -> Bool -> String,nested_Inh_Chunk :: Bool,options_Inh_Chunk :: Options,optionsLine_Inh_Chunk :: String,pragmaBlocks_Inh_Chunk :: String,textBlocks_Inh_Chunk :: PP_Doc} data Syn_Chunk = Syn_Chunk {appendCommon_Syn_Chunk :: [[PP_Doc]],appendMain_Syn_Chunk :: [[PP_Doc]],genSems_Syn_Chunk :: IO (),imports_Syn_Chunk :: [String],pps_Syn_Chunk :: PP_Docs} wrap_Chunk (T_Chunk sem) (Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) = (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) = (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) in (Syn_Chunk _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps)) sem_Chunk_Chunk :: String -> T_Decl -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> ([String]) -> T_Chunk sem_Chunk_Chunk name_ (T_Decl comment_) (T_Decls info_) (T_Decls dataDef_) (T_Decls cataFun_) (T_Decls semDom_) (T_Decls semWrapper_) (T_Decls semFunctions_) semNames_ = (T_Chunk (\ _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks -> (let _lhsOpps :: PP_Docs _lhsOimports :: ([String]) _lhsOappendCommon :: ([[PP_Doc]]) _lhsOappendMain :: ([[PP_Doc]]) _lhsOgenSems :: (IO ()) _commentOisDeclOfLet :: Bool _commentOnested :: Bool _commentOoptions :: Options _commentOoutputfile :: String _infoOisDeclOfLet :: Bool _infoOnested :: Bool _infoOoptions :: Options _infoOoutputfile :: String _dataDefOisDeclOfLet :: Bool _dataDefOnested :: Bool _dataDefOoptions :: Options _dataDefOoutputfile :: String _cataFunOisDeclOfLet :: Bool _cataFunOnested :: Bool _cataFunOoptions :: Options _cataFunOoutputfile :: String _semDomOisDeclOfLet :: Bool _semDomOnested :: Bool _semDomOoptions :: Options _semDomOoutputfile :: String _semWrapperOisDeclOfLet :: Bool _semWrapperOnested :: Bool _semWrapperOoptions :: Options _semWrapperOoutputfile :: String _semFunctionsOisDeclOfLet :: Bool _semFunctionsOnested :: Bool _semFunctionsOoptions :: Options _semFunctionsOoutputfile :: String _commentIpp :: PP_Doc _infoIpps :: PP_Docs _dataDefIpps :: PP_Docs _cataFunIpps :: PP_Docs _semDomIpps :: PP_Docs _semWrapperIpps :: PP_Docs _semFunctionsIpps :: PP_Docs -- "PrintCode.ag"(line 37, column 7) _outputfile = if sepSemMods _lhsIoptions then _lhsImainFile ++ "_" ++ name_ ++ ".hs" else _lhsImainFile ++ ".hs" -- "PrintCode.ag"(line 83, column 16) _lhsOpps = _commentIpp : _infoIpps ++ _dataDefIpps ++ _cataFunIpps ++ _semDomIpps ++ _semWrapperIpps ++ _semFunctionsIpps -- "PrintCode.ag"(line 383, column 7) _lhsOimports = ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] -- "PrintCode.ag"(line 389, column 7) _lhsOappendCommon = [ [_commentIpp] , _dataDefIpps , _semDomIpps ] -- "PrintCode.ag"(line 394, column 7) _lhsOappendMain = [ [_commentIpp] , _cataFunIpps , _semWrapperIpps ] -- "PrintCode.ag"(line 404, column 7) _lhsOgenSems = writeModule _outputfile [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True , pp $ ("import " ++ _lhsImainName ++ "_common\n") , _commentIpp , vlist_sep "" _infoIpps , vlist_sep "" _semFunctionsIpps ] -- "PrintCode.ag"(line 417, column 7) _exports = concat $ intersperse "," semNames_ -- copy rule (down) _commentOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _commentOnested = _lhsInested -- copy rule (down) _commentOoptions = _lhsIoptions -- copy rule (from local) _commentOoutputfile = _outputfile -- copy rule (down) _infoOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _infoOnested = _lhsInested -- copy rule (down) _infoOoptions = _lhsIoptions -- copy rule (from local) _infoOoutputfile = _outputfile -- copy rule (down) _dataDefOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _dataDefOnested = _lhsInested -- copy rule (down) _dataDefOoptions = _lhsIoptions -- copy rule (from local) _dataDefOoutputfile = _outputfile -- copy rule (down) _cataFunOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _cataFunOnested = _lhsInested -- copy rule (down) _cataFunOoptions = _lhsIoptions -- copy rule (from local) _cataFunOoutputfile = _outputfile -- copy rule (down) _semDomOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _semDomOnested = _lhsInested -- copy rule (down) _semDomOoptions = _lhsIoptions -- copy rule (from local) _semDomOoutputfile = _outputfile -- copy rule (down) _semWrapperOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _semWrapperOnested = _lhsInested -- copy rule (down) _semWrapperOoptions = _lhsIoptions -- copy rule (from local) _semWrapperOoutputfile = _outputfile -- copy rule (down) _semFunctionsOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _semFunctionsOnested = _lhsInested -- copy rule (down) _semFunctionsOoptions = _lhsIoptions -- copy rule (from local) _semFunctionsOoutputfile = _outputfile ( _commentIpp) = (comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile) ( _infoIpps) = (info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile) ( _dataDefIpps) = (dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile) ( _cataFunIpps) = (cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile) ( _semDomIpps) = (semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile) ( _semWrapperIpps) = (semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile) ( _semFunctionsIpps) = (semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile) in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps)))) -- Chunks ------------------------------------------------------ {- visit 0: inherited attributes: importBlocks : PP_Doc isDeclOfLet : Bool mainFile : String mainName : String moduleHeader : String -> String -> String -> Bool -> String nested : Bool options : Options optionsLine : String pragmaBlocks : String textBlocks : PP_Doc synthesized attributes: appendCommon : [[PP_Doc]] appendMain : [[PP_Doc]] genSems : IO () imports : [String] pps : PP_Docs alternatives: alternative Cons: child hd : Chunk child tl : Chunks alternative Nil: -} -- cata sem_Chunks :: Chunks -> T_Chunks sem_Chunks list = (Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list)) -- semantic domain newtype T_Chunks = T_Chunks (PP_Doc -> Bool -> String -> String -> (String -> String -> String -> Bool -> String) -> Bool -> Options -> String -> String -> PP_Doc -> ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs)) data Inh_Chunks = Inh_Chunks {importBlocks_Inh_Chunks :: PP_Doc,isDeclOfLet_Inh_Chunks :: Bool,mainFile_Inh_Chunks :: String,mainName_Inh_Chunks :: String,moduleHeader_Inh_Chunks :: String -> String -> String -> Bool -> String,nested_Inh_Chunks :: Bool,options_Inh_Chunks :: Options,optionsLine_Inh_Chunks :: String,pragmaBlocks_Inh_Chunks :: String,textBlocks_Inh_Chunks :: PP_Doc} data Syn_Chunks = Syn_Chunks {appendCommon_Syn_Chunks :: [[PP_Doc]],appendMain_Syn_Chunks :: [[PP_Doc]],genSems_Syn_Chunks :: IO (),imports_Syn_Chunks :: [String],pps_Syn_Chunks :: PP_Docs} wrap_Chunks (T_Chunks sem) (Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) = (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) = (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) in (Syn_Chunks _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps)) sem_Chunks_Cons :: T_Chunk -> T_Chunks -> T_Chunks sem_Chunks_Cons (T_Chunk hd_) (T_Chunks tl_) = (T_Chunks (\ _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks -> (let _lhsOpps :: PP_Docs _lhsOappendCommon :: ([[PP_Doc]]) _lhsOappendMain :: ([[PP_Doc]]) _lhsOgenSems :: (IO ()) _lhsOimports :: ([String]) _hdOimportBlocks :: PP_Doc _hdOisDeclOfLet :: Bool _hdOmainFile :: String _hdOmainName :: String _hdOmoduleHeader :: (String -> String -> String -> Bool -> String) _hdOnested :: Bool _hdOoptions :: Options _hdOoptionsLine :: String _hdOpragmaBlocks :: String _hdOtextBlocks :: PP_Doc _tlOimportBlocks :: PP_Doc _tlOisDeclOfLet :: Bool _tlOmainFile :: String _tlOmainName :: String _tlOmoduleHeader :: (String -> String -> String -> Bool -> String) _tlOnested :: Bool _tlOoptions :: Options _tlOoptionsLine :: String _tlOpragmaBlocks :: String _tlOtextBlocks :: PP_Doc _hdIappendCommon :: ([[PP_Doc]]) _hdIappendMain :: ([[PP_Doc]]) _hdIgenSems :: (IO ()) _hdIimports :: ([String]) _hdIpps :: PP_Docs _tlIappendCommon :: ([[PP_Doc]]) _tlIappendMain :: ([[PP_Doc]]) _tlIgenSems :: (IO ()) _tlIimports :: ([String]) _tlIpps :: PP_Docs -- "PrintCode.ag"(line 75, column 10) _lhsOpps = _hdIpps ++ _tlIpps -- use rule "PrintCode.ag"(line 385, column 50) _lhsOappendCommon = _hdIappendCommon ++ _tlIappendCommon -- use rule "PrintCode.ag"(line 385, column 50) _lhsOappendMain = _hdIappendMain ++ _tlIappendMain -- use rule "PrintCode.ag"(line 400, column 33) _lhsOgenSems = _hdIgenSems >> _tlIgenSems -- use rule "PrintCode.ag"(line 380, column 33) _lhsOimports = _hdIimports ++ _tlIimports -- copy rule (down) _hdOimportBlocks = _lhsIimportBlocks -- copy rule (down) _hdOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _hdOmainFile = _lhsImainFile -- copy rule (down) _hdOmainName = _lhsImainName -- copy rule (down) _hdOmoduleHeader = _lhsImoduleHeader -- copy rule (down) _hdOnested = _lhsInested -- copy rule (down) _hdOoptions = _lhsIoptions -- copy rule (down) _hdOoptionsLine = _lhsIoptionsLine -- copy rule (down) _hdOpragmaBlocks = _lhsIpragmaBlocks -- copy rule (down) _hdOtextBlocks = _lhsItextBlocks -- copy rule (down) _tlOimportBlocks = _lhsIimportBlocks -- copy rule (down) _tlOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _tlOmainFile = _lhsImainFile -- copy rule (down) _tlOmainName = _lhsImainName -- copy rule (down) _tlOmoduleHeader = _lhsImoduleHeader -- copy rule (down) _tlOnested = _lhsInested -- copy rule (down) _tlOoptions = _lhsIoptions -- copy rule (down) _tlOoptionsLine = _lhsIoptionsLine -- copy rule (down) _tlOpragmaBlocks = _lhsIpragmaBlocks -- copy rule (down) _tlOtextBlocks = _lhsItextBlocks ( _hdIappendCommon,_hdIappendMain,_hdIgenSems,_hdIimports,_hdIpps) = (hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlocks) ( _tlIappendCommon,_tlIappendMain,_tlIgenSems,_tlIimports,_tlIpps) = (tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlocks) in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps)))) sem_Chunks_Nil :: T_Chunks sem_Chunks_Nil = (T_Chunks (\ _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks -> (let _lhsOpps :: PP_Docs _lhsOappendCommon :: ([[PP_Doc]]) _lhsOappendMain :: ([[PP_Doc]]) _lhsOgenSems :: (IO ()) _lhsOimports :: ([String]) -- "PrintCode.ag"(line 76, column 10) _lhsOpps = [] -- use rule "PrintCode.ag"(line 385, column 50) _lhsOappendCommon = [] -- use rule "PrintCode.ag"(line 385, column 50) _lhsOappendMain = [] -- use rule "PrintCode.ag"(line 400, column 33) _lhsOgenSems = return () -- use rule "PrintCode.ag"(line 380, column 33) _lhsOimports = [] in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps)))) -- DataAlt ----------------------------------------------------- {- visit 0: inherited attributes: nested : Bool strictPre : PP_Doc synthesized attribute: pp : PP_Doc alternatives: alternative DataAlt: child name : {String} child args : {[String]} alternative Record: child name : {String} child args : {[(String,String)]} -} -- cata sem_DataAlt :: DataAlt -> T_DataAlt sem_DataAlt (DataAlt _name _args) = (sem_DataAlt_DataAlt _name _args) sem_DataAlt (Record _name _args) = (sem_DataAlt_Record _name _args) -- semantic domain newtype T_DataAlt = T_DataAlt (Bool -> PP_Doc -> ( PP_Doc)) data Inh_DataAlt = Inh_DataAlt {nested_Inh_DataAlt :: Bool,strictPre_Inh_DataAlt :: PP_Doc} data Syn_DataAlt = Syn_DataAlt {pp_Syn_DataAlt :: PP_Doc} wrap_DataAlt (T_DataAlt sem) (Inh_DataAlt _lhsInested _lhsIstrictPre) = (let ( _lhsOpp) = (sem _lhsInested _lhsIstrictPre) in (Syn_DataAlt _lhsOpp)) sem_DataAlt_DataAlt :: String -> ([String]) -> T_DataAlt sem_DataAlt_DataAlt name_ args_ = (T_DataAlt (\ _lhsInested _lhsIstrictPre -> (let _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 153, column 16) _lhsOpp = name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens . text) args_) in ( _lhsOpp)))) sem_DataAlt_Record :: String -> ([(String,String)]) -> T_DataAlt sem_DataAlt_Record name_ args_ = (T_DataAlt (\ _lhsInested _lhsIstrictPre -> (let _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 154, column 16) _lhsOpp = name_ >#< pp_block "{" "}" "," [ f >#< "::" >#< t | (f,t) <- args_ ] in ( _lhsOpp)))) -- DataAlts ---------------------------------------------------- {- visit 0: inherited attributes: nested : Bool strictPre : PP_Doc synthesized attribute: pps : PP_Docs alternatives: alternative Cons: child hd : DataAlt child tl : DataAlts alternative Nil: -} -- cata sem_DataAlts :: DataAlts -> T_DataAlts sem_DataAlts list = (Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list)) -- semantic domain newtype T_DataAlts = T_DataAlts (Bool -> PP_Doc -> ( PP_Docs)) data Inh_DataAlts = Inh_DataAlts {nested_Inh_DataAlts :: Bool,strictPre_Inh_DataAlts :: PP_Doc} data Syn_DataAlts = Syn_DataAlts {pps_Syn_DataAlts :: PP_Docs} wrap_DataAlts (T_DataAlts sem) (Inh_DataAlts _lhsInested _lhsIstrictPre) = (let ( _lhsOpps) = (sem _lhsInested _lhsIstrictPre) in (Syn_DataAlts _lhsOpps)) sem_DataAlts_Cons :: T_DataAlt -> T_DataAlts -> T_DataAlts sem_DataAlts_Cons (T_DataAlt hd_) (T_DataAlts tl_) = (T_DataAlts (\ _lhsInested _lhsIstrictPre -> (let _lhsOpps :: PP_Docs _hdOnested :: Bool _hdOstrictPre :: PP_Doc _tlOnested :: Bool _tlOstrictPre :: PP_Doc _hdIpp :: PP_Doc _tlIpps :: PP_Docs -- "PrintCode.ag"(line 63, column 10) _lhsOpps = _hdIpp : _tlIpps -- copy rule (down) _hdOnested = _lhsInested -- copy rule (down) _hdOstrictPre = _lhsIstrictPre -- copy rule (down) _tlOnested = _lhsInested -- copy rule (down) _tlOstrictPre = _lhsIstrictPre ( _hdIpp) = (hd_ _hdOnested _hdOstrictPre) ( _tlIpps) = (tl_ _tlOnested _tlOstrictPre) in ( _lhsOpps)))) sem_DataAlts_Nil :: T_DataAlts sem_DataAlts_Nil = (T_DataAlts (\ _lhsInested _lhsIstrictPre -> (let _lhsOpps :: PP_Docs -- "PrintCode.ag"(line 64, column 10) _lhsOpps = [] in ( _lhsOpps)))) -- Decl -------------------------------------------------------- {- visit 0: inherited attributes: isDeclOfLet : Bool nested : Bool options : Options outputfile : String synthesized attribute: pp : PP_Doc alternatives: alternative Comment: child txt : {String} alternative Data: child name : {String} child params : {[String]} child alts : DataAlts child strict : {Bool} child derivings : {[String]} alternative Decl: child left : Lhs child rhs : Expr child binds : {Set String} child uses : {Set String} alternative NewType: child name : {String} child params : {[String]} child con : {String} child tp : Type alternative PragmaDecl: child txt : {String} alternative TSig: child name : {String} child tp : Type alternative Type: child name : {String} child params : {[String]} child tp : Type -} -- cata sem_Decl :: Decl -> T_Decl sem_Decl (Comment _txt) = (sem_Decl_Comment _txt) sem_Decl (Data _name _params _alts _strict _derivings) = (sem_Decl_Data _name _params (sem_DataAlts _alts) _strict _derivings) sem_Decl (Decl _left _rhs _binds _uses) = (sem_Decl_Decl (sem_Lhs _left) (sem_Expr _rhs) _binds _uses) sem_Decl (NewType _name _params _con _tp) = (sem_Decl_NewType _name _params _con (sem_Type _tp)) sem_Decl (PragmaDecl _txt) = (sem_Decl_PragmaDecl _txt) sem_Decl (TSig _name _tp) = (sem_Decl_TSig _name (sem_Type _tp)) sem_Decl (Type _name _params _tp) = (sem_Decl_Type _name _params (sem_Type _tp)) -- semantic domain newtype T_Decl = T_Decl (Bool -> Bool -> Options -> String -> ( PP_Doc)) data Inh_Decl = Inh_Decl {isDeclOfLet_Inh_Decl :: Bool,nested_Inh_Decl :: Bool,options_Inh_Decl :: Options,outputfile_Inh_Decl :: String} data Syn_Decl = Syn_Decl {pp_Syn_Decl :: PP_Doc} wrap_Decl (T_Decl sem) (Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = (let ( _lhsOpp) = (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) in (Syn_Decl _lhsOpp)) sem_Decl_Comment :: String -> T_Decl sem_Decl_Comment txt_ = (T_Decl (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 106, column 16) _lhsOpp = if '\n' `elem` txt_ then "{-" >-< vlist (lines txt_) >-< "-}" else "--" >#< txt_ in ( _lhsOpp)))) sem_Decl_Data :: String -> ([String]) -> T_DataAlts -> Bool -> ([String]) -> T_Decl sem_Decl_Data name_ params_ (T_DataAlts alts_) strict_ derivings_ = (T_Decl (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _altsOstrictPre :: PP_Doc _altsOnested :: Bool _altsIpps :: PP_Docs -- "PrintCode.ag"(line 94, column 16) _lhsOpp = "data" >#< hv_sp (name_ : params_) >#< ( case _altsIpps of [] -> empty (x:xs) -> "=" >#< x >-< vlist (map ("|" >#<) xs) >-< if null derivings_ then empty else "deriving" >#< ppTuple False (map text derivings_) ) -- "PrintCode.ag"(line 228, column 10) _altsOstrictPre = if strict_ then pp "!" else empty -- copy rule (down) _altsOnested = _lhsInested ( _altsIpps) = (alts_ _altsOnested _altsOstrictPre) in ( _lhsOpp)))) sem_Decl_Decl :: T_Lhs -> T_Expr -> (Set String) -> (Set String) -> T_Decl sem_Decl_Decl (T_Lhs left_) (T_Expr rhs_) binds_ uses_ = (T_Decl (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _leftOisDeclOfLet :: Bool _leftOnested :: Bool _leftOoptions :: Options _leftOoutputfile :: String _rhsOnested :: Bool _rhsOoptions :: Options _rhsOoutputfile :: String _leftIpp :: PP_Doc _rhsIpp :: PP_Doc -- "PrintCode.ag"(line 92, column 16) _lhsOpp = _leftIpp >#< "=" >-< indent 4 _rhsIpp -- copy rule (down) _leftOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _leftOnested = _lhsInested -- copy rule (down) _leftOoptions = _lhsIoptions -- copy rule (down) _leftOoutputfile = _lhsIoutputfile -- copy rule (down) _rhsOnested = _lhsInested -- copy rule (down) _rhsOoptions = _lhsIoptions -- copy rule (down) _rhsOoutputfile = _lhsIoutputfile ( _leftIpp) = (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) ( _rhsIpp) = (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile) in ( _lhsOpp)))) sem_Decl_NewType :: String -> ([String]) -> String -> T_Type -> T_Decl sem_Decl_NewType name_ params_ con_ (T_Type tp_) = (T_Decl (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _tpOnested :: Bool _tpIpp :: PP_Doc _tpIprec :: Int -- "PrintCode.ag"(line 103, column 16) _lhsOpp = "newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp -- copy rule (down) _tpOnested = _lhsInested ( _tpIpp,_tpIprec) = (tp_ _tpOnested) in ( _lhsOpp)))) sem_Decl_PragmaDecl :: String -> T_Decl sem_Decl_PragmaDecl txt_ = (T_Decl (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 109, column 16) _lhsOpp = "{-#" >#< text txt_ >#< "#-}" in ( _lhsOpp)))) sem_Decl_TSig :: String -> T_Type -> T_Decl sem_Decl_TSig name_ (T_Type tp_) = (T_Decl (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _tpOnested :: Bool _tpIpp :: PP_Doc _tpIprec :: Int -- "PrintCode.ag"(line 105, column 16) _lhsOpp = name_ >#< "::" >#< _tpIpp -- copy rule (down) _tpOnested = _lhsInested ( _tpIpp,_tpIprec) = (tp_ _tpOnested) in ( _lhsOpp)))) sem_Decl_Type :: String -> ([String]) -> T_Type -> T_Decl sem_Decl_Type name_ params_ (T_Type tp_) = (T_Decl (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _tpOnested :: Bool _tpIpp :: PP_Doc _tpIprec :: Int -- "PrintCode.ag"(line 104, column 16) _lhsOpp = "type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp -- copy rule (down) _tpOnested = _lhsInested ( _tpIpp,_tpIprec) = (tp_ _tpOnested) in ( _lhsOpp)))) -- Decls ------------------------------------------------------- {- visit 0: inherited attributes: isDeclOfLet : Bool nested : Bool options : Options outputfile : String synthesized attribute: pps : PP_Docs alternatives: alternative Cons: child hd : Decl child tl : Decls alternative Nil: -} -- cata sem_Decls :: Decls -> T_Decls sem_Decls list = (Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list)) -- semantic domain newtype T_Decls = T_Decls (Bool -> Bool -> Options -> String -> ( PP_Docs)) data Inh_Decls = Inh_Decls {isDeclOfLet_Inh_Decls :: Bool,nested_Inh_Decls :: Bool,options_Inh_Decls :: Options,outputfile_Inh_Decls :: String} data Syn_Decls = Syn_Decls {pps_Syn_Decls :: PP_Docs} wrap_Decls (T_Decls sem) (Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = (let ( _lhsOpps) = (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) in (Syn_Decls _lhsOpps)) sem_Decls_Cons :: T_Decl -> T_Decls -> T_Decls sem_Decls_Cons (T_Decl hd_) (T_Decls tl_) = (T_Decls (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpps :: PP_Docs _hdOisDeclOfLet :: Bool _hdOnested :: Bool _hdOoptions :: Options _hdOoutputfile :: String _tlOisDeclOfLet :: Bool _tlOnested :: Bool _tlOoptions :: Options _tlOoutputfile :: String _hdIpp :: PP_Doc _tlIpps :: PP_Docs -- "PrintCode.ag"(line 71, column 10) _lhsOpps = _hdIpp : _tlIpps -- copy rule (down) _hdOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _hdOnested = _lhsInested -- copy rule (down) _hdOoptions = _lhsIoptions -- copy rule (down) _hdOoutputfile = _lhsIoutputfile -- copy rule (down) _tlOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _tlOnested = _lhsInested -- copy rule (down) _tlOoptions = _lhsIoptions -- copy rule (down) _tlOoutputfile = _lhsIoutputfile ( _hdIpp) = (hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile) ( _tlIpps) = (tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile) in ( _lhsOpps)))) sem_Decls_Nil :: T_Decls sem_Decls_Nil = (T_Decls (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpps :: PP_Docs -- "PrintCode.ag"(line 72, column 10) _lhsOpps = [] in ( _lhsOpps)))) -- Expr -------------------------------------------------------- {- visit 0: inherited attributes: nested : Bool options : Options outputfile : String synthesized attribute: pp : PP_Doc alternatives: alternative App: child name : {String} child args : Exprs alternative Case: child expr : Expr child alts : CaseAlts alternative Lambda: child args : Exprs child body : Expr visit 0: local strictParams : _ local addBang : _ alternative Let: child decls : Decls child body : Expr alternative LineExpr: child expr : Expr alternative PragmaExpr: child onLeftSide : {Bool} child onNewLine : {Bool} child txt : {String} child expr : Expr alternative SimpleExpr: child txt : {String} alternative TextExpr: child lns : {[String]} alternative Trace: child txt : {String} child expr : Expr alternative TupleExpr: child exprs : Exprs alternative TypedExpr: child expr : Expr child tp : Type alternative UnboxedTupleExpr: child exprs : Exprs -} -- cata sem_Expr :: Expr -> T_Expr sem_Expr (App _name _args) = (sem_Expr_App _name (sem_Exprs _args)) sem_Expr (Case _expr _alts) = (sem_Expr_Case (sem_Expr _expr) (sem_CaseAlts _alts)) sem_Expr (Lambda _args _body) = (sem_Expr_Lambda (sem_Exprs _args) (sem_Expr _body)) sem_Expr (Let _decls _body) = (sem_Expr_Let (sem_Decls _decls) (sem_Expr _body)) sem_Expr (LineExpr _expr) = (sem_Expr_LineExpr (sem_Expr _expr)) sem_Expr (PragmaExpr _onLeftSide _onNewLine _txt _expr) = (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr)) sem_Expr (SimpleExpr _txt) = (sem_Expr_SimpleExpr _txt) sem_Expr (TextExpr _lns) = (sem_Expr_TextExpr _lns) sem_Expr (Trace _txt _expr) = (sem_Expr_Trace _txt (sem_Expr _expr)) sem_Expr (TupleExpr _exprs) = (sem_Expr_TupleExpr (sem_Exprs _exprs)) sem_Expr (TypedExpr _expr _tp) = (sem_Expr_TypedExpr (sem_Expr _expr) (sem_Type _tp)) sem_Expr (UnboxedTupleExpr _exprs) = (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs)) -- semantic domain newtype T_Expr = T_Expr (Bool -> Options -> String -> ( PP_Doc)) data Inh_Expr = Inh_Expr {nested_Inh_Expr :: Bool,options_Inh_Expr :: Options,outputfile_Inh_Expr :: String} data Syn_Expr = Syn_Expr {pp_Syn_Expr :: PP_Doc} wrap_Expr (T_Expr sem) (Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) = (let ( _lhsOpp) = (sem _lhsInested _lhsIoptions _lhsIoutputfile) in (Syn_Expr _lhsOpp)) sem_Expr_App :: String -> T_Exprs -> T_Expr sem_Expr_App name_ (T_Exprs args_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _argsOnested :: Bool _argsOoptions :: Options _argsOoutputfile :: String _argsIpps :: PP_Docs -- "PrintCode.ag"(line 129, column 16) _lhsOpp = pp_parens $ name_ >#< hv_sp _argsIpps -- copy rule (down) _argsOnested = _lhsInested -- copy rule (down) _argsOoptions = _lhsIoptions -- copy rule (down) _argsOoutputfile = _lhsIoutputfile ( _argsIpps) = (args_ _argsOnested _argsOoptions _argsOoutputfile) in ( _lhsOpp)))) sem_Expr_Case :: T_Expr -> T_CaseAlts -> T_Expr sem_Expr_Case (T_Expr expr_) (T_CaseAlts alts_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _exprOnested :: Bool _exprOoptions :: Options _exprOoutputfile :: String _altsOnested :: Bool _altsOoptions :: Options _altsOoutputfile :: String _exprIpp :: PP_Doc _altsIpps :: PP_Docs -- "PrintCode.ag"(line 115, column 16) _lhsOpp = pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" >-< (vlist _altsIpps) ) -- copy rule (down) _exprOnested = _lhsInested -- copy rule (down) _exprOoptions = _lhsIoptions -- copy rule (down) _exprOoutputfile = _lhsIoutputfile -- copy rule (down) _altsOnested = _lhsInested -- copy rule (down) _altsOoptions = _lhsIoptions -- copy rule (down) _altsOoutputfile = _lhsIoutputfile ( _exprIpp) = (expr_ _exprOnested _exprOoptions _exprOoutputfile) ( _altsIpps) = (alts_ _altsOnested _altsOoptions _altsOoutputfile) in ( _lhsOpp)))) sem_Expr_Lambda :: T_Exprs -> T_Expr -> T_Expr sem_Expr_Lambda (T_Exprs args_) (T_Expr body_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _argsOnested :: Bool _argsOoptions :: Options _argsOoutputfile :: String _bodyOnested :: Bool _bodyOoptions :: Options _bodyOoutputfile :: String _argsIpps :: PP_Docs _bodyIpp :: PP_Doc -- "PrintCode.ag"(line 118, column 16) _strictParams = if strictSems _lhsIoptions then _argsIpps else [] -- "PrintCode.ag"(line 121, column 16) _addBang = if bangpats _lhsIoptions then \p -> pp_parens ("!" >|< p) else id -- "PrintCode.ag"(line 124, column 16) _lhsOpp = pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) ) -- copy rule (down) _argsOnested = _lhsInested -- copy rule (down) _argsOoptions = _lhsIoptions -- copy rule (down) _argsOoutputfile = _lhsIoutputfile -- copy rule (down) _bodyOnested = _lhsInested -- copy rule (down) _bodyOoptions = _lhsIoptions -- copy rule (down) _bodyOoutputfile = _lhsIoutputfile ( _argsIpps) = (args_ _argsOnested _argsOoptions _argsOoutputfile) ( _bodyIpp) = (body_ _bodyOnested _bodyOoptions _bodyOoutputfile) in ( _lhsOpp)))) sem_Expr_Let :: T_Decls -> T_Expr -> T_Expr sem_Expr_Let (T_Decls decls_) (T_Expr body_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _declsOisDeclOfLet :: Bool _declsOnested :: Bool _declsOoptions :: Options _declsOoutputfile :: String _bodyOnested :: Bool _bodyOoptions :: Options _bodyOoutputfile :: String _declsIpps :: PP_Docs _bodyIpp :: PP_Doc -- "PrintCode.ag"(line 112, column 16) _lhsOpp = pp_parens ( "let" >#< (vlist _declsIpps) >-< "in " >#< _bodyIpp ) -- "PrintCode.ag"(line 322, column 7) _declsOisDeclOfLet = True -- copy rule (down) _declsOnested = _lhsInested -- copy rule (down) _declsOoptions = _lhsIoptions -- copy rule (down) _declsOoutputfile = _lhsIoutputfile -- copy rule (down) _bodyOnested = _lhsInested -- copy rule (down) _bodyOoptions = _lhsIoptions -- copy rule (down) _bodyOoutputfile = _lhsIoutputfile ( _declsIpps) = (decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile) ( _bodyIpp) = (body_ _bodyOnested _bodyOoptions _bodyOoutputfile) in ( _lhsOpp)))) sem_Expr_LineExpr :: T_Expr -> T_Expr sem_Expr_LineExpr (T_Expr expr_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _exprOnested :: Bool _exprOoptions :: Options _exprOoutputfile :: String _exprIpp :: PP_Doc -- "PrintCode.ag"(line 146, column 16) _lhsOpp = _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}" -- copy rule (down) _exprOnested = _lhsInested -- copy rule (down) _exprOoptions = _lhsIoptions -- copy rule (down) _exprOoutputfile = _lhsIoutputfile ( _exprIpp) = (expr_ _exprOnested _exprOoptions _exprOoutputfile) in ( _lhsOpp)))) sem_Expr_PragmaExpr :: Bool -> Bool -> String -> T_Expr -> T_Expr sem_Expr_PragmaExpr onLeftSide_ onNewLine_ txt_ (T_Expr expr_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _exprOnested :: Bool _exprOoptions :: Options _exprOoutputfile :: String _exprIpp :: PP_Doc -- "PrintCode.ag"(line 135, column 16) _lhsOpp = let pragmaDoc = "{-#" >#< txt_ >#< "#-}" op = if onNewLine_ then (>-<) else (>#<) leftOp x y = if onLeftSide_ then x `op` y else y rightOp x y = if onLeftSide_ then x else x `op` y in pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc -- copy rule (down) _exprOnested = _lhsInested -- copy rule (down) _exprOoptions = _lhsIoptions -- copy rule (down) _exprOoutputfile = _lhsIoutputfile ( _exprIpp) = (expr_ _exprOnested _exprOoptions _exprOoutputfile) in ( _lhsOpp)))) sem_Expr_SimpleExpr :: String -> T_Expr sem_Expr_SimpleExpr txt_ = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 130, column 16) _lhsOpp = text txt_ in ( _lhsOpp)))) sem_Expr_TextExpr :: ([String]) -> T_Expr sem_Expr_TextExpr lns_ = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 131, column 16) _lhsOpp = vlist (map text lns_) in ( _lhsOpp)))) sem_Expr_Trace :: String -> T_Expr -> T_Expr sem_Expr_Trace txt_ (T_Expr expr_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _exprOnested :: Bool _exprOoptions :: Options _exprOoutputfile :: String _exprIpp :: PP_Doc -- "PrintCode.ag"(line 132, column 16) _lhsOpp = "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") >-< pp_parens _exprIpp ) -- copy rule (down) _exprOnested = _lhsInested -- copy rule (down) _exprOoptions = _lhsIoptions -- copy rule (down) _exprOoutputfile = _lhsIoutputfile ( _exprIpp) = (expr_ _exprOnested _exprOoptions _exprOoutputfile) in ( _lhsOpp)))) sem_Expr_TupleExpr :: T_Exprs -> T_Expr sem_Expr_TupleExpr (T_Exprs exprs_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _exprsOnested :: Bool _exprsOoptions :: Options _exprsOoutputfile :: String _exprsIpps :: PP_Docs -- "PrintCode.ag"(line 127, column 16) _lhsOpp = ppTuple _lhsInested _exprsIpps -- copy rule (down) _exprsOnested = _lhsInested -- copy rule (down) _exprsOoptions = _lhsIoptions -- copy rule (down) _exprsOoutputfile = _lhsIoutputfile ( _exprsIpps) = (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile) in ( _lhsOpp)))) sem_Expr_TypedExpr :: T_Expr -> T_Type -> T_Expr sem_Expr_TypedExpr (T_Expr expr_) (T_Type tp_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _exprOnested :: Bool _exprOoptions :: Options _exprOoutputfile :: String _tpOnested :: Bool _exprIpp :: PP_Doc _tpIpp :: PP_Doc _tpIprec :: Int -- "PrintCode.ag"(line 147, column 16) _lhsOpp = pp_parens (_exprIpp >#< "::" >#< _tpIpp) -- copy rule (down) _exprOnested = _lhsInested -- copy rule (down) _exprOoptions = _lhsIoptions -- copy rule (down) _exprOoutputfile = _lhsIoutputfile -- copy rule (down) _tpOnested = _lhsInested ( _exprIpp) = (expr_ _exprOnested _exprOoptions _exprOoutputfile) ( _tpIpp,_tpIprec) = (tp_ _tpOnested) in ( _lhsOpp)))) sem_Expr_UnboxedTupleExpr :: T_Exprs -> T_Expr sem_Expr_UnboxedTupleExpr (T_Exprs exprs_) = (T_Expr (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _exprsOnested :: Bool _exprsOoptions :: Options _exprsOoutputfile :: String _exprsIpps :: PP_Docs -- "PrintCode.ag"(line 128, column 23) _lhsOpp = ppUnboxedTuple _lhsInested _exprsIpps -- copy rule (down) _exprsOnested = _lhsInested -- copy rule (down) _exprsOoptions = _lhsIoptions -- copy rule (down) _exprsOoutputfile = _lhsIoutputfile ( _exprsIpps) = (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile) in ( _lhsOpp)))) -- Exprs ------------------------------------------------------- {- visit 0: inherited attributes: nested : Bool options : Options outputfile : String synthesized attribute: pps : PP_Docs alternatives: alternative Cons: child hd : Expr child tl : Exprs alternative Nil: -} -- cata sem_Exprs :: Exprs -> T_Exprs sem_Exprs list = (Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list)) -- semantic domain newtype T_Exprs = T_Exprs (Bool -> Options -> String -> ( PP_Docs)) data Inh_Exprs = Inh_Exprs {nested_Inh_Exprs :: Bool,options_Inh_Exprs :: Options,outputfile_Inh_Exprs :: String} data Syn_Exprs = Syn_Exprs {pps_Syn_Exprs :: PP_Docs} wrap_Exprs (T_Exprs sem) (Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile) = (let ( _lhsOpps) = (sem _lhsInested _lhsIoptions _lhsIoutputfile) in (Syn_Exprs _lhsOpps)) sem_Exprs_Cons :: T_Expr -> T_Exprs -> T_Exprs sem_Exprs_Cons (T_Expr hd_) (T_Exprs tl_) = (T_Exprs (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpps :: PP_Docs _hdOnested :: Bool _hdOoptions :: Options _hdOoutputfile :: String _tlOnested :: Bool _tlOoptions :: Options _tlOoutputfile :: String _hdIpp :: PP_Doc _tlIpps :: PP_Docs -- "PrintCode.ag"(line 55, column 10) _lhsOpps = _hdIpp : _tlIpps -- copy rule (down) _hdOnested = _lhsInested -- copy rule (down) _hdOoptions = _lhsIoptions -- copy rule (down) _hdOoutputfile = _lhsIoutputfile -- copy rule (down) _tlOnested = _lhsInested -- copy rule (down) _tlOoptions = _lhsIoptions -- copy rule (down) _tlOoutputfile = _lhsIoutputfile ( _hdIpp) = (hd_ _hdOnested _hdOoptions _hdOoutputfile) ( _tlIpps) = (tl_ _tlOnested _tlOoptions _tlOoutputfile) in ( _lhsOpps)))) sem_Exprs_Nil :: T_Exprs sem_Exprs_Nil = (T_Exprs (\ _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpps :: PP_Docs -- "PrintCode.ag"(line 56, column 10) _lhsOpps = [] in ( _lhsOpps)))) -- Lhs --------------------------------------------------------- {- visit 0: inherited attributes: isDeclOfLet : Bool nested : Bool options : Options outputfile : String synthesized attribute: pp : PP_Doc alternatives: alternative Fun: child name : {String} child args : Exprs visit 0: local addStrictGuard : _ local hasStrictVars : _ local strictGuard : _ local addBang : _ alternative Pattern3: child pat3 : Pattern visit 0: local addStrictGuard : _ local strictGuard : _ local hasStrictVars : _ alternative Pattern3SM: child pat3 : Pattern alternative TupleLhs: child comps : {[String]} visit 0: local addStrictGuard : _ local strictGuard : _ local hasStrictVars : _ local addBang : _ alternative UnboxedTupleLhs: child comps : {[String]} visit 0: local addStrictGuard : _ local strictGuard : _ local hasStrictVars : _ local addBang : _ -} -- cata sem_Lhs :: Lhs -> T_Lhs sem_Lhs (Fun _name _args) = (sem_Lhs_Fun _name (sem_Exprs _args)) sem_Lhs (Pattern3 _pat3) = (sem_Lhs_Pattern3 (sem_Pattern _pat3)) sem_Lhs (Pattern3SM _pat3) = (sem_Lhs_Pattern3SM (sem_Pattern _pat3)) sem_Lhs (TupleLhs _comps) = (sem_Lhs_TupleLhs _comps) sem_Lhs (UnboxedTupleLhs _comps) = (sem_Lhs_UnboxedTupleLhs _comps) -- semantic domain newtype T_Lhs = T_Lhs (Bool -> Bool -> Options -> String -> ( PP_Doc)) data Inh_Lhs = Inh_Lhs {isDeclOfLet_Inh_Lhs :: Bool,nested_Inh_Lhs :: Bool,options_Inh_Lhs :: Options,outputfile_Inh_Lhs :: String} data Syn_Lhs = Syn_Lhs {pp_Syn_Lhs :: PP_Doc} wrap_Lhs (T_Lhs sem) (Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = (let ( _lhsOpp) = (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) in (Syn_Lhs _lhsOpp)) sem_Lhs_Fun :: String -> T_Exprs -> T_Lhs sem_Lhs_Fun name_ (T_Exprs args_) = (T_Lhs (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _argsOnested :: Bool _argsOoptions :: Options _argsOoutputfile :: String _argsIpps :: PP_Docs -- "PrintCode.ag"(line 169, column 7) _addStrictGuard = if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id -- "PrintCode.ag"(line 170, column 7) _hasStrictVars = not (null _argsIpps) -- "PrintCode.ag"(line 171, column 7) _strictGuard = _argsIpps `ppMultiSeqH` (pp "True") -- "PrintCode.ag"(line 174, column 7) _addBang = if bangpats _lhsIoptions then \p -> "!" >|< p else id -- "PrintCode.ag"(line 182, column 16) _lhsOpp = _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) -- copy rule (down) _argsOnested = _lhsInested -- copy rule (down) _argsOoptions = _lhsIoptions -- copy rule (down) _argsOoutputfile = _lhsIoutputfile ( _argsIpps) = (args_ _argsOnested _argsOoptions _argsOoutputfile) in ( _lhsOpp)))) sem_Lhs_Pattern3 :: T_Pattern -> T_Lhs sem_Lhs_Pattern3 (T_Pattern pat3_) = (T_Lhs (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _pat3ObelowIrrefutable :: Bool _pat3OisDeclOfLet :: Bool _pat3Ooptions :: Options _pat3Icopy :: Pattern _pat3IisUnderscore :: Bool _pat3Ipp :: PP_Doc _pat3Ipp' :: PP_Doc _pat3IstrictVars :: ([PP_Doc]) -- "PrintCode.ag"(line 158, column 7) _addStrictGuard = if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id -- "PrintCode.ag"(line 160, column 7) _strictGuard = _pat3IstrictVars `ppMultiSeqH` (pp "True") -- "PrintCode.ag"(line 161, column 7) _hasStrictVars = not (null _pat3IstrictVars) -- "PrintCode.ag"(line 178, column 16) _lhsOpp = _addStrictGuard _pat3Ipp -- "PrintCode.ag"(line 288, column 7) _pat3ObelowIrrefutable = False -- copy rule (down) _pat3OisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _pat3Ooptions = _lhsIoptions ( _pat3Icopy,_pat3IisUnderscore,_pat3Ipp,_pat3Ipp',_pat3IstrictVars) = (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) in ( _lhsOpp)))) sem_Lhs_Pattern3SM :: T_Pattern -> T_Lhs sem_Lhs_Pattern3SM (T_Pattern pat3_) = (T_Lhs (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc _pat3ObelowIrrefutable :: Bool _pat3OisDeclOfLet :: Bool _pat3Ooptions :: Options _pat3Icopy :: Pattern _pat3IisUnderscore :: Bool _pat3Ipp :: PP_Doc _pat3Ipp' :: PP_Doc _pat3IstrictVars :: ([PP_Doc]) -- "PrintCode.ag"(line 179, column 16) _lhsOpp = _pat3Ipp' -- "PrintCode.ag"(line 288, column 7) _pat3ObelowIrrefutable = False -- copy rule (down) _pat3OisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _pat3Ooptions = _lhsIoptions ( _pat3Icopy,_pat3IisUnderscore,_pat3Ipp,_pat3Ipp',_pat3IstrictVars) = (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) in ( _lhsOpp)))) sem_Lhs_TupleLhs :: ([String]) -> T_Lhs sem_Lhs_TupleLhs comps_ = (T_Lhs (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 158, column 7) _addStrictGuard = if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id -- "PrintCode.ag"(line 163, column 7) _strictGuard = if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then map text comps_ `ppMultiSeqH` (pp "True") else pp "True" -- "PrintCode.ag"(line 166, column 7) _hasStrictVars = not (null comps_) -- "PrintCode.ag"(line 174, column 7) _addBang = if bangpats _lhsIoptions then \p -> "!" >|< p else id -- "PrintCode.ag"(line 180, column 16) _lhsOpp = _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) in ( _lhsOpp)))) sem_Lhs_UnboxedTupleLhs :: ([String]) -> T_Lhs sem_Lhs_UnboxedTupleLhs comps_ = (T_Lhs (\ _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile -> (let _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 158, column 7) _addStrictGuard = if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id -- "PrintCode.ag"(line 163, column 7) _strictGuard = if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then map text comps_ `ppMultiSeqH` (pp "True") else pp "True" -- "PrintCode.ag"(line 166, column 7) _hasStrictVars = not (null comps_) -- "PrintCode.ag"(line 174, column 7) _addBang = if bangpats _lhsIoptions then \p -> "!" >|< p else id -- "PrintCode.ag"(line 181, column 23) _lhsOpp = _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) in ( _lhsOpp)))) -- Pattern ----------------------------------------------------- {- visit 0: inherited attributes: belowIrrefutable : Bool isDeclOfLet : Bool options : Options synthesized attributes: copy : SELF isUnderscore : Bool pp : PP_Doc pp' : PP_Doc strictVars : [PP_Doc] alternatives: alternative Alias: child field : {Identifier} child attr : {Identifier} child pat : Pattern child parts : Patterns visit 0: local strictVar : _ local strictPatVars : _ local addBang : _ local ppVar : _ local ppVarBang : _ local copy : _ alternative Constr: child name : {ConstructorIdent} child pats : Patterns visit 0: local addBang : _ local copy : _ alternative Irrefutable: child pat : Pattern visit 0: local copy : _ alternative Product: child pos : {Pos} child pats : Patterns visit 0: local addBang : _ local copy : _ alternative Underscore: child pos : {Pos} visit 0: local copy : _ -} -- cata sem_Pattern :: Pattern -> T_Pattern sem_Pattern (Alias _field _attr _pat _parts) = (sem_Pattern_Alias _field _attr (sem_Pattern _pat) (sem_Patterns _parts)) sem_Pattern (Constr _name _pats) = (sem_Pattern_Constr _name (sem_Patterns _pats)) sem_Pattern (Irrefutable _pat) = (sem_Pattern_Irrefutable (sem_Pattern _pat)) sem_Pattern (Product _pos _pats) = (sem_Pattern_Product _pos (sem_Patterns _pats)) sem_Pattern (Underscore _pos) = (sem_Pattern_Underscore _pos) -- semantic domain newtype T_Pattern = T_Pattern (Bool -> Bool -> Options -> ( Pattern,Bool,PP_Doc,PP_Doc,([PP_Doc]))) data Inh_Pattern = Inh_Pattern {belowIrrefutable_Inh_Pattern :: Bool,isDeclOfLet_Inh_Pattern :: Bool,options_Inh_Pattern :: Options} data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,isUnderscore_Syn_Pattern :: Bool,pp_Syn_Pattern :: PP_Doc,pp'_Syn_Pattern :: PP_Doc,strictVars_Syn_Pattern :: [PP_Doc]} wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = (let ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) = (sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) in (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars)) sem_Pattern_Alias :: Identifier -> Identifier -> T_Pattern -> T_Patterns -> T_Pattern sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) = (T_Pattern (\ _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions -> (let _lhsOstrictVars :: ([PP_Doc]) _lhsOpp :: PP_Doc _lhsOisUnderscore :: Bool _lhsOpp' :: PP_Doc _lhsOcopy :: Pattern _patObelowIrrefutable :: Bool _patOisDeclOfLet :: Bool _patOoptions :: Options _partsObelowIrrefutable :: Bool _partsOisDeclOfLet :: Bool _partsOoptions :: Options _patIcopy :: Pattern _patIisUnderscore :: Bool _patIpp :: PP_Doc _patIpp' :: PP_Doc _patIstrictVars :: ([PP_Doc]) _partsIcopy :: Patterns _partsIpps :: ([PP_Doc]) _partsIpps' :: ([PP_Doc]) _partsIstrictVars :: ([PP_Doc]) -- "PrintCode.ag"(line 237, column 7) _strictVar = if strictCases _lhsIoptions && not _lhsIisDeclOfLet then [_ppVar ] else [] -- "PrintCode.ag"(line 241, column 7) _strictPatVars = if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then _patIstrictVars else [] -- "PrintCode.ag"(line 245, column 7) _lhsOstrictVars = _strictVar ++ _strictPatVars -- "PrintCode.ag"(line 260, column 7) _addBang = if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id -- "PrintCode.ag"(line 267, column 13) _ppVar = pp (attrname False field_ attr_) -- "PrintCode.ag"(line 268, column 13) _ppVarBang = _addBang $ _ppVar -- "PrintCode.ag"(line 269, column 13) _lhsOpp = if _patIisUnderscore then _ppVarBang else _ppVarBang >|< "@" >|< _patIpp -- "PrintCode.ag"(line 278, column 16) _lhsOisUnderscore = False -- "PrintCode.ag"(line 301, column 13) _lhsOpp' = let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ | otherwise = attrname False field_ attr_ in attribute >|< "@" >|< _patIpp' -- self rule _copy = Alias field_ attr_ _patIcopy _partsIcopy -- self rule _lhsOcopy = _copy -- copy rule (down) _patObelowIrrefutable = _lhsIbelowIrrefutable -- copy rule (down) _patOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _patOoptions = _lhsIoptions -- copy rule (down) _partsObelowIrrefutable = _lhsIbelowIrrefutable -- copy rule (down) _partsOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _partsOoptions = _lhsIoptions ( _patIcopy,_patIisUnderscore,_patIpp,_patIpp',_patIstrictVars) = (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions) ( _partsIcopy,_partsIpps,_partsIpps',_partsIstrictVars) = (parts_ _partsObelowIrrefutable _partsOisDeclOfLet _partsOoptions) in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) sem_Pattern_Constr :: ConstructorIdent -> T_Patterns -> T_Pattern sem_Pattern_Constr name_ (T_Patterns pats_) = (T_Pattern (\ _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions -> (let _lhsOpp :: PP_Doc _lhsOisUnderscore :: Bool _lhsOpp' :: PP_Doc _lhsOstrictVars :: ([PP_Doc]) _lhsOcopy :: Pattern _patsObelowIrrefutable :: Bool _patsOisDeclOfLet :: Bool _patsOoptions :: Options _patsIcopy :: Patterns _patsIpps :: ([PP_Doc]) _patsIpps' :: ([PP_Doc]) _patsIstrictVars :: ([PP_Doc]) -- "PrintCode.ag"(line 260, column 7) _addBang = if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id -- "PrintCode.ag"(line 265, column 13) _lhsOpp = _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps -- "PrintCode.ag"(line 276, column 16) _lhsOisUnderscore = False -- "PrintCode.ag"(line 299, column 13) _lhsOpp' = pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') -- use rule "PrintCode.ag"(line 234, column 40) _lhsOstrictVars = _patsIstrictVars -- self rule _copy = Constr name_ _patsIcopy -- self rule _lhsOcopy = _copy -- copy rule (down) _patsObelowIrrefutable = _lhsIbelowIrrefutable -- copy rule (down) _patsOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _patsOoptions = _lhsIoptions ( _patsIcopy,_patsIpps,_patsIpps',_patsIstrictVars) = (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable (T_Pattern pat_) = (T_Pattern (\ _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions -> (let _lhsOstrictVars :: ([PP_Doc]) _lhsOpp :: PP_Doc _patObelowIrrefutable :: Bool _lhsOpp' :: PP_Doc _lhsOcopy :: Pattern _lhsOisUnderscore :: Bool _patOisDeclOfLet :: Bool _patOoptions :: Options _patIcopy :: Pattern _patIisUnderscore :: Bool _patIpp :: PP_Doc _patIpp' :: PP_Doc _patIstrictVars :: ([PP_Doc]) -- "PrintCode.ag"(line 248, column 7) _lhsOstrictVars = [] -- "PrintCode.ag"(line 272, column 17) _lhsOpp = text "~" >|< pp_parens _patIpp -- "PrintCode.ag"(line 284, column 7) _patObelowIrrefutable = True -- "PrintCode.ag"(line 304, column 17) _lhsOpp' = text "~" >|< pp_parens _patIpp -- self rule _copy = Irrefutable _patIcopy -- self rule _lhsOcopy = _copy -- copy rule (up) _lhsOisUnderscore = _patIisUnderscore -- copy rule (down) _patOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _patOoptions = _lhsIoptions ( _patIcopy,_patIisUnderscore,_patIpp,_patIpp',_patIstrictVars) = (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions) in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) sem_Pattern_Product :: Pos -> T_Patterns -> T_Pattern sem_Pattern_Product pos_ (T_Patterns pats_) = (T_Pattern (\ _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions -> (let _lhsOpp :: PP_Doc _lhsOisUnderscore :: Bool _lhsOpp' :: PP_Doc _lhsOstrictVars :: ([PP_Doc]) _lhsOcopy :: Pattern _patsObelowIrrefutable :: Bool _patsOisDeclOfLet :: Bool _patsOoptions :: Options _patsIcopy :: Patterns _patsIpps :: ([PP_Doc]) _patsIpps' :: ([PP_Doc]) _patsIstrictVars :: ([PP_Doc]) -- "PrintCode.ag"(line 260, column 7) _addBang = if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id -- "PrintCode.ag"(line 266, column 13) _lhsOpp = _addBang $ pp_block "(" ")" "," _patsIpps -- "PrintCode.ag"(line 277, column 16) _lhsOisUnderscore = False -- "PrintCode.ag"(line 300, column 13) _lhsOpp' = pp_block "(" ")" "," _patsIpps' -- use rule "PrintCode.ag"(line 234, column 40) _lhsOstrictVars = _patsIstrictVars -- self rule _copy = Product pos_ _patsIcopy -- self rule _lhsOcopy = _copy -- copy rule (down) _patsObelowIrrefutable = _lhsIbelowIrrefutable -- copy rule (down) _patsOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _patsOoptions = _lhsIoptions ( _patsIcopy,_patsIpps,_patsIpps',_patsIstrictVars) = (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) sem_Pattern_Underscore :: Pos -> T_Pattern sem_Pattern_Underscore pos_ = (T_Pattern (\ _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions -> (let _lhsOpp :: PP_Doc _lhsOisUnderscore :: Bool _lhsOpp' :: PP_Doc _lhsOstrictVars :: ([PP_Doc]) _lhsOcopy :: Pattern -- "PrintCode.ag"(line 273, column 16) _lhsOpp = text "_" -- "PrintCode.ag"(line 279, column 16) _lhsOisUnderscore = True -- "PrintCode.ag"(line 305, column 16) _lhsOpp' = text "_" -- use rule "PrintCode.ag"(line 234, column 40) _lhsOstrictVars = [] -- self rule _copy = Underscore pos_ -- self rule _lhsOcopy = _copy in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) -- Patterns ---------------------------------------------------- {- visit 0: inherited attributes: belowIrrefutable : Bool isDeclOfLet : Bool options : Options synthesized attributes: copy : SELF pps : [PP_Doc] pps' : [PP_Doc] strictVars : [PP_Doc] alternatives: alternative Cons: child hd : Pattern child tl : Patterns visit 0: local copy : _ alternative Nil: visit 0: local copy : _ -} -- cata sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) -- semantic domain newtype T_Patterns = T_Patterns (Bool -> Bool -> Options -> ( Patterns,([PP_Doc]),([PP_Doc]),([PP_Doc]))) data Inh_Patterns = Inh_Patterns {belowIrrefutable_Inh_Patterns :: Bool,isDeclOfLet_Inh_Patterns :: Bool,options_Inh_Patterns :: Options} data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,pps_Syn_Patterns :: [PP_Doc],pps'_Syn_Patterns :: [PP_Doc],strictVars_Syn_Patterns :: [PP_Doc]} wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = (let ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) = (sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) in (Syn_Patterns _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars)) sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = (T_Patterns (\ _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions -> (let _lhsOpps :: ([PP_Doc]) _lhsOpps' :: ([PP_Doc]) _lhsOstrictVars :: ([PP_Doc]) _lhsOcopy :: Patterns _hdObelowIrrefutable :: Bool _hdOisDeclOfLet :: Bool _hdOoptions :: Options _tlObelowIrrefutable :: Bool _tlOisDeclOfLet :: Bool _tlOoptions :: Options _hdIcopy :: Pattern _hdIisUnderscore :: Bool _hdIpp :: PP_Doc _hdIpp' :: PP_Doc _hdIstrictVars :: ([PP_Doc]) _tlIcopy :: Patterns _tlIpps :: ([PP_Doc]) _tlIpps' :: ([PP_Doc]) _tlIstrictVars :: ([PP_Doc]) -- "PrintCode.ag"(line 255, column 10) _lhsOpps = _hdIpp : _tlIpps -- "PrintCode.ag"(line 295, column 10) _lhsOpps' = _hdIpp' : _tlIpps' -- use rule "PrintCode.ag"(line 234, column 40) _lhsOstrictVars = _hdIstrictVars ++ _tlIstrictVars -- self rule _copy = (:) _hdIcopy _tlIcopy -- self rule _lhsOcopy = _copy -- copy rule (down) _hdObelowIrrefutable = _lhsIbelowIrrefutable -- copy rule (down) _hdOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _hdOoptions = _lhsIoptions -- copy rule (down) _tlObelowIrrefutable = _lhsIbelowIrrefutable -- copy rule (down) _tlOisDeclOfLet = _lhsIisDeclOfLet -- copy rule (down) _tlOoptions = _lhsIoptions ( _hdIcopy,_hdIisUnderscore,_hdIpp,_hdIpp',_hdIstrictVars) = (hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions) ( _tlIcopy,_tlIpps,_tlIpps',_tlIstrictVars) = (tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions) in ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars)))) sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = (T_Patterns (\ _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions -> (let _lhsOpps :: ([PP_Doc]) _lhsOpps' :: ([PP_Doc]) _lhsOstrictVars :: ([PP_Doc]) _lhsOcopy :: Patterns -- "PrintCode.ag"(line 256, column 10) _lhsOpps = [] -- "PrintCode.ag"(line 296, column 10) _lhsOpps' = [] -- use rule "PrintCode.ag"(line 234, column 40) _lhsOstrictVars = [] -- self rule _copy = [] -- self rule _lhsOcopy = _copy in ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars)))) -- Program ----------------------------------------------------- {- visit 0: inherited attributes: importBlocks : PP_Doc mainFile : String mainName : String moduleHeader : String -> String -> String -> Bool -> String options : Options optionsLine : String pragmaBlocks : String textBlocks : PP_Doc synthesized attributes: genIO : IO () output : PP_Docs alternatives: alternative Program: child chunks : Chunks visit 0: local mainModuleFile : _ local genMainModule : _ local commonFile : _ local genCommonModule : _ -} -- cata sem_Program :: Program -> T_Program sem_Program (Program _chunks) = (sem_Program_Program (sem_Chunks _chunks)) -- semantic domain newtype T_Program = T_Program (PP_Doc -> String -> String -> (String -> String -> String -> Bool -> String) -> Options -> String -> String -> PP_Doc -> ( (IO ()),PP_Docs)) data Inh_Program = Inh_Program {importBlocks_Inh_Program :: PP_Doc,mainFile_Inh_Program :: String,mainName_Inh_Program :: String,moduleHeader_Inh_Program :: String -> String -> String -> Bool -> String,options_Inh_Program :: Options,optionsLine_Inh_Program :: String,pragmaBlocks_Inh_Program :: String,textBlocks_Inh_Program :: PP_Doc} data Syn_Program = Syn_Program {genIO_Syn_Program :: IO (),output_Syn_Program :: PP_Docs} wrap_Program (T_Program sem) (Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) = (let ( _lhsOgenIO,_lhsOoutput) = (sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) in (Syn_Program _lhsOgenIO _lhsOoutput)) sem_Program_Program :: T_Chunks -> T_Program sem_Program_Program (T_Chunks chunks_) = (T_Program (\ _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks -> (let _chunksOnested :: Bool _lhsOoutput :: PP_Docs _chunksOisDeclOfLet :: Bool _lhsOgenIO :: (IO ()) _chunksOimportBlocks :: PP_Doc _chunksOmainFile :: String _chunksOmainName :: String _chunksOmoduleHeader :: (String -> String -> String -> Bool -> String) _chunksOoptions :: Options _chunksOoptionsLine :: String _chunksOpragmaBlocks :: String _chunksOtextBlocks :: PP_Doc _chunksIappendCommon :: ([[PP_Doc]]) _chunksIappendMain :: ([[PP_Doc]]) _chunksIgenSems :: (IO ()) _chunksIimports :: ([String]) _chunksIpps :: PP_Docs -- "PrintCode.ag"(line 52, column 13) _chunksOnested = nest _lhsIoptions -- "PrintCode.ag"(line 80, column 16) _lhsOoutput = _chunksIpps -- "PrintCode.ag"(line 318, column 7) _chunksOisDeclOfLet = False -- "PrintCode.ag"(line 347, column 7) _mainModuleFile = _lhsImainFile ++ ".hs" -- "PrintCode.ag"(line 348, column 7) _genMainModule = writeModule _mainModuleFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName "" "" False , pp $ ("import " ++ _lhsImainName ++ "_common\n") ] ++ map pp _chunksIimports ++ map vlist _chunksIappendMain ) -- "PrintCode.ag"(line 359, column 7) _commonFile = _lhsImainFile ++ "_common.hs" -- "PrintCode.ag"(line 360, column 7) _genCommonModule = writeModule _commonFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True , _lhsIimportBlocks , _lhsItextBlocks ] ++ map vlist _chunksIappendCommon ) -- "PrintCode.ag"(line 371, column 7) _lhsOgenIO = do _genMainModule _genCommonModule _chunksIgenSems -- copy rule (down) _chunksOimportBlocks = _lhsIimportBlocks -- copy rule (down) _chunksOmainFile = _lhsImainFile -- copy rule (down) _chunksOmainName = _lhsImainName -- copy rule (down) _chunksOmoduleHeader = _lhsImoduleHeader -- copy rule (down) _chunksOoptions = _lhsIoptions -- copy rule (down) _chunksOoptionsLine = _lhsIoptionsLine -- copy rule (down) _chunksOpragmaBlocks = _lhsIpragmaBlocks -- copy rule (down) _chunksOtextBlocks = _lhsItextBlocks ( _chunksIappendCommon,_chunksIappendMain,_chunksIgenSems,_chunksIimports,_chunksIpps) = (chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlocks) in ( _lhsOgenIO,_lhsOoutput)))) -- Type -------------------------------------------------------- {- visit 0: inherited attribute: nested : Bool synthesized attributes: pp : PP_Doc prec : Int alternatives: alternative Arr: child left : Type child right : Type visit 0: local l : _ local r : _ alternative CtxApp: child left : {[(String, [String])]} child right : Type alternative List: child tp : Type alternative SimpleType: child txt : {String} alternative TupleType: child tps : Types alternative TypeApp: child func : Type child args : Types alternative UnboxedTupleType: child tps : Types -} -- cata sem_Type :: Type -> T_Type sem_Type (Arr _left _right) = (sem_Type_Arr (sem_Type _left) (sem_Type _right)) sem_Type (CtxApp _left _right) = (sem_Type_CtxApp _left (sem_Type _right)) sem_Type (List _tp) = (sem_Type_List (sem_Type _tp)) sem_Type (SimpleType _txt) = (sem_Type_SimpleType _txt) sem_Type (TupleType _tps) = (sem_Type_TupleType (sem_Types _tps)) sem_Type (TypeApp _func _args) = (sem_Type_TypeApp (sem_Type _func) (sem_Types _args)) sem_Type (UnboxedTupleType _tps) = (sem_Type_UnboxedTupleType (sem_Types _tps)) -- semantic domain newtype T_Type = T_Type (Bool -> ( PP_Doc,Int)) data Inh_Type = Inh_Type {nested_Inh_Type :: Bool} data Syn_Type = Syn_Type {pp_Syn_Type :: PP_Doc,prec_Syn_Type :: Int} wrap_Type (T_Type sem) (Inh_Type _lhsInested) = (let ( _lhsOpp,_lhsOprec) = (sem _lhsInested) in (Syn_Type _lhsOpp _lhsOprec)) sem_Type_Arr :: T_Type -> T_Type -> T_Type sem_Type_Arr (T_Type left_) (T_Type right_) = (T_Type (\ _lhsInested -> (let _lhsOprec :: Int _lhsOpp :: PP_Doc _leftOnested :: Bool _rightOnested :: Bool _leftIpp :: PP_Doc _leftIprec :: Int _rightIpp :: PP_Doc _rightIprec :: Int -- "PrintCode.ag"(line 185, column 16) _lhsOprec = 2 -- "PrintCode.ag"(line 185, column 16) _lhsOpp = _l >#< "->" >-< _r -- "PrintCode.ag"(line 187, column 16) _l = if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp -- "PrintCode.ag"(line 187, column 16) _r = if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp -- copy rule (down) _leftOnested = _lhsInested -- copy rule (down) _rightOnested = _lhsInested ( _leftIpp,_leftIprec) = (left_ _leftOnested) ( _rightIpp,_rightIprec) = (right_ _rightOnested) in ( _lhsOpp,_lhsOprec)))) sem_Type_CtxApp :: ([(String, [String])]) -> T_Type -> T_Type sem_Type_CtxApp left_ (T_Type right_) = (T_Type (\ _lhsInested -> (let _lhsOpp :: PP_Doc _lhsOprec :: Int _rightOnested :: Bool _rightIpp :: PP_Doc _rightIprec :: Int -- "PrintCode.ag"(line 194, column 7) _lhsOpp = (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp -- copy rule (up) _lhsOprec = _rightIprec -- copy rule (down) _rightOnested = _lhsInested ( _rightIpp,_rightIprec) = (right_ _rightOnested) in ( _lhsOpp,_lhsOprec)))) sem_Type_List :: T_Type -> T_Type sem_Type_List (T_Type tp_) = (T_Type (\ _lhsInested -> (let _lhsOprec :: Int _lhsOpp :: PP_Doc _tpOnested :: Bool _tpIpp :: PP_Doc _tpIprec :: Int -- "PrintCode.ag"(line 202, column 16) _lhsOprec = 5 -- "PrintCode.ag"(line 202, column 16) _lhsOpp = "[" >|< _tpIpp >|< "]" -- copy rule (down) _tpOnested = _lhsInested ( _tpIpp,_tpIprec) = (tp_ _tpOnested) in ( _lhsOpp,_lhsOprec)))) sem_Type_SimpleType :: String -> T_Type sem_Type_SimpleType txt_ = (T_Type (\ _lhsInested -> (let _lhsOprec :: Int _lhsOpp :: PP_Doc -- "PrintCode.ag"(line 205, column 16) _lhsOprec = 5 -- "PrintCode.ag"(line 205, column 16) _lhsOpp = if reallySimple txt_ then text txt_ else pp_parens (text txt_) in ( _lhsOpp,_lhsOprec)))) sem_Type_TupleType :: T_Types -> T_Type sem_Type_TupleType (T_Types tps_) = (T_Type (\ _lhsInested -> (let _lhsOprec :: Int _lhsOpp :: PP_Doc _tpsOnested :: Bool _tpsIpps :: PP_Docs -- "PrintCode.ag"(line 196, column 16) _lhsOprec = 5 -- "PrintCode.ag"(line 196, column 16) _lhsOpp = ppTuple _lhsInested _tpsIpps -- copy rule (down) _tpsOnested = _lhsInested ( _tpsIpps) = (tps_ _tpsOnested) in ( _lhsOpp,_lhsOprec)))) sem_Type_TypeApp :: T_Type -> T_Types -> T_Type sem_Type_TypeApp (T_Type func_) (T_Types args_) = (T_Type (\ _lhsInested -> (let _lhsOpp :: PP_Doc _lhsOprec :: Int _funcOnested :: Bool _argsOnested :: Bool _funcIpp :: PP_Doc _funcIprec :: Int _argsIpps :: PP_Docs -- "PrintCode.ag"(line 191, column 7) _lhsOpp = hv_sp (_funcIpp : _argsIpps) -- copy rule (up) _lhsOprec = _funcIprec -- copy rule (down) _funcOnested = _lhsInested -- copy rule (down) _argsOnested = _lhsInested ( _funcIpp,_funcIprec) = (func_ _funcOnested) ( _argsIpps) = (args_ _argsOnested) in ( _lhsOpp,_lhsOprec)))) sem_Type_UnboxedTupleType :: T_Types -> T_Type sem_Type_UnboxedTupleType (T_Types tps_) = (T_Type (\ _lhsInested -> (let _lhsOprec :: Int _lhsOpp :: PP_Doc _tpsOnested :: Bool _tpsIpps :: PP_Docs -- "PrintCode.ag"(line 199, column 23) _lhsOprec = 5 -- "PrintCode.ag"(line 199, column 23) _lhsOpp = ppUnboxedTuple _lhsInested _tpsIpps -- copy rule (down) _tpsOnested = _lhsInested ( _tpsIpps) = (tps_ _tpsOnested) in ( _lhsOpp,_lhsOprec)))) -- Types ------------------------------------------------------- {- visit 0: inherited attribute: nested : Bool synthesized attribute: pps : PP_Docs alternatives: alternative Cons: child hd : Type child tl : Types alternative Nil: -} -- cata sem_Types :: Types -> T_Types sem_Types list = (Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list)) -- semantic domain newtype T_Types = T_Types (Bool -> ( PP_Docs)) data Inh_Types = Inh_Types {nested_Inh_Types :: Bool} data Syn_Types = Syn_Types {pps_Syn_Types :: PP_Docs} wrap_Types (T_Types sem) (Inh_Types _lhsInested) = (let ( _lhsOpps) = (sem _lhsInested) in (Syn_Types _lhsOpps)) sem_Types_Cons :: T_Type -> T_Types -> T_Types sem_Types_Cons (T_Type hd_) (T_Types tl_) = (T_Types (\ _lhsInested -> (let _lhsOpps :: PP_Docs _hdOnested :: Bool _tlOnested :: Bool _hdIpp :: PP_Doc _hdIprec :: Int _tlIpps :: PP_Docs -- "PrintCode.ag"(line 67, column 10) _lhsOpps = _hdIpp : _tlIpps -- copy rule (down) _hdOnested = _lhsInested -- copy rule (down) _tlOnested = _lhsInested ( _hdIpp,_hdIprec) = (hd_ _hdOnested) ( _tlIpps) = (tl_ _tlOnested) in ( _lhsOpps)))) sem_Types_Nil :: T_Types sem_Types_Nil = (T_Types (\ _lhsInested -> (let _lhsOpps :: PP_Docs -- "PrintCode.ag"(line 68, column 10) _lhsOpps = [] in ( _lhsOpps))))