uuagc-0.9.6: src-derived/PrintCode.hs
-- 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))))