+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"
+ parenPar = AST.unsafeVHDLBasicId "paren"
+ showSpec = AST.Function showId [AST.IfaceVarDec adtPar adtTM, AST.IfaceVarDec parenPar booleanTM] stringTM
+ showExpr = AST.CaseSm ((selectedName adtPar) (mkVHDLBasicId conLbl))
+ [AST.CaseSmAlt [AST.ChoiceE $ AST.PrimLit $ show x] (
+ if (null (elemIdss!!x)) then
+ [AST.ReturnSm (Just $ ((genExprFCall2 showId) . (\x -> (selectedName adtPar x, AST.PrimLit "false")) $ mkVHDLBasicId conLbl) AST.:&: showFields x)]
+ else
+ [addParens (((genExprFCall2 showId) . (\x -> (selectedName adtPar x, AST.PrimLit "false")) $ 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.:&:) . (genExprFCall2 showId) . (\x -> (selectedName adtPar x, AST.PrimLit "true")))
+ (map mkVHDLBasicId (elemIdss!!i))
+ selectedName par = (AST.PrimName . AST.NSelected . (AST.NSimple par AST.:.:) . tupVHDLSuffix)
+ addParens :: AST.Expr -> AST.SeqSm
+ addParens k = AST.IfSm (AST.PrimName (AST.NSimple parenPar))
+ [AST.ReturnSm (Just (AST.PrimLit "'('" AST.:&: k AST.:&: AST.PrimLit "')'" ))]
+ []
+ (Just $ AST.Else [AST.ReturnSm (Just k)])
+