X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FVHDL%2FVHDLTools.hs;h=a70036ef33b56ff60816390b43505b7f7fcb6e77;hb=b149566951240b283ca05fd1fe5447f0801d6b99;hp=639452bcbef3f6a00aa6f1189e88e70e343d4b59;hpb=4583b2b6d86da12e795f199f2951b193efed613f;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/clash/CLasH/VHDL/VHDLTools.hs b/clash/CLasH/VHDL/VHDLTools.hs index 639452b..a70036e 100644 --- a/clash/CLasH/VHDL/VHDLTools.hs +++ b/clash/CLasH/VHDL/VHDLTools.hs @@ -370,8 +370,8 @@ mkTyConHType tycon args = 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 @@ -390,8 +390,8 @@ mkTyConHType tycon args = -- 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)) @@ -581,6 +581,17 @@ getFieldLabels :: -> [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