X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FVHDL%2FVHDLTools.hs;h=4e396cae620695772c586c82350490e7d4e84338;hb=6823534f88656932f8ea21d3c0abfe75e76f3935;hp=bc5f497038f6e7b8167135899d1644d4db85b611;hpb=3f39038911a675d91b5147761e16296d3ab25743;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/clash/CLasH/VHDL/VHDLTools.hs b/clash/CLasH/VHDL/VHDLTools.hs index bc5f497..4e396ca 100644 --- a/clash/CLasH/VHDL/VHDLTools.hs +++ b/clash/CLasH/VHDL/VHDLTools.hs @@ -206,10 +206,7 @@ dataconToVHDLExpr dc = do varToVHDLId :: CoreSyn.CoreBndr -> AST.VHDLId -varToVHDLId var = mkVHDLExtId (varToString var ++ varToStringUniq var ++ show (lowers $ varToStringUniq var)) - where - lowers :: String -> Int - lowers xs = length [x | x <- xs, Char.isLower x] +varToVHDLId var = mkVHDLExtId $ varToUniqString var -- Creates a VHDL Name from a binder varToVHDLName :: @@ -223,6 +220,14 @@ varToString :: -> String varToString = OccName.occNameString . Name.nameOccName . Var.varName +varToUniqString :: + CoreSyn.CoreBndr + -> String +varToUniqString var = (varToString var ++ varToStringUniq var ++ show (lowers $ varToStringUniq var)) + where + lowers :: String -> Int + lowers xs = length [x | x <- xs, Char.isLower x] + -- Get the string version a Var's unique varToStringUniq :: Var.Var -> String varToStringUniq = show . Var.varUnique @@ -384,7 +389,7 @@ mkTyConHType tycon args = -- If we get here, then all of the argument types were state -- types (we check for enumeration types at the top). Not -- sure how to handle this, so error out for now. - (_, []) -> error $ "ADT with only State elements (or something like that?) Dunno how to handle this yet. Tycon: " ++ pprString tycon ++ " Arguments: " ++ pprString args + (_, []) -> return $ Right StateType --error $ "VHDLTools.mkTyConHType: ADT with only State elements (or something like that?) Dunno how to handle this yet. Tycon: " ++ pprString tycon ++ " Arguments: " ++ pprString args -- A full ADT (with multiple fields and one or multiple -- constructors). (_, elem_htys) -> do