let real_arg_tyss_nostate = map (filter (\x -> not (isStateType x))) real_arg_tyss
elem_htyss_either <- mapM (mapM mkHTypeEither) real_arg_tyss_nostate
let (errors, elem_htyss) = unzip (map Either.partitionEithers elem_htyss_either)
- case errors of
- [] -> case (dcs, concat elem_htyss) of
+ case (all null errors) of
+ True -> case (dcs, concat elem_htyss) of
-- A single constructor with a single (non-state) field?
([dc], [elem_hty]) -> return $ Right elem_hty
-- If we get here, then all of the argument types were state
-- Create the AggrType HType
return $ Right $ AggrType name enum_ty_part fieldss
-- There were errors in element types
- errors -> return $ Left $
- "\nVHDLTools.mkTyConHType: Can not construct type for: " ++ pprString tycon ++ "\n because no type can be construced for some of the arguments.\n"
+ False -> return $ Left $
+ "\nVHDLTools.mkTyConHType: Can not construct type for: " ++ pprString tycon ++ "\n because no type can be construced for some of the arguments.\n"
++ (concat $ concat errors)
where
name = (nameToString (TyCon.tyConName tycon))
-> [AST.VHDLId] -- ^ The labels
getFieldLabels htype dc_i = ((map mkVHDLBasicId) . (map fst)) (getFields htype dc_i)
+-- Finds the field label for the constructor field, if any.
+getConstructorFieldLabel ::
+ HType
+ -> Maybe AST.VHDLId
+getConstructorFieldLabel (AggrType _ (Just con) _) =
+ Just $ mkVHDLBasicId (fst con)
+getConstructorFieldLabel (AggrType _ Nothing _) =
+ Nothing
+getConstructorFieldLabel htype =
+ error $ "Can't get constructor field label from non-aggregate HType: " ++ show htype
+
mktydecl :: (AST.VHDLId, Maybe (Either AST.TypeDef AST.SubtypeIn)) -> Maybe AST.PackageDecItem
mytydecl (_, Nothing) = Nothing
mktydecl (ty_id, Just (Left ty_def)) = Just $ AST.PDITD $ AST.TypeDec ty_id ty_def