+mkAdtShow ::
+ String
+ -> [String] -- Constructors
+ -> [[String]] -- Fields for every constructor
+ -> AST.TypeMark
+ -> AST.SubProgBody
+mkAdtShow conLbl conIds elemIdss adtTM = AST.SubProgBody showSpec [] [showExpr]
+ where
+ adtPar = AST.unsafeVHDLBasicId "adt"
+ showSpec = AST.Function showId [AST.IfaceVarDec adtPar adtTM] stringTM
+ showExpr = AST.CaseSm ((selectedName adtPar) (mkVHDLBasicId conLbl))
+ [AST.CaseSmAlt [AST.ChoiceE $ AST.PrimLit $ show x]
+ [AST.ReturnSm (Just $ ((genExprFCall showId) . (selectedName adtPar) $ mkVHDLBasicId conLbl) AST.:&: showFields x)] | x <- [0..(length conIds) -1]]
+ showFields i = if (null (elemIdss!!i)) then
+ AST.PrimLit "''"
+ else
+ foldr1 (\e1 e2 -> e1 AST.:&: e2) $
+ map ((AST.PrimLit "' '" AST.:&:) . (genExprFCall showId) . (selectedName adtPar))
+ (map mkVHDLBasicId (elemIdss!!i))
+ selectedName par = (AST.PrimName . AST.NSelected . (AST.NSimple par AST.:.:) . tupVHDLSuffix)
+