From c8676a7aec4420d558936beedfb578479c4575cf Mon Sep 17 00:00:00 2001 From: christiaanb Date: Wed, 23 Jun 2010 11:55:38 +0200 Subject: [PATCH] Z-encode invalid names instead of using extended identifiers. External tools recognize \ as escape-character --- clash/CLasH/Utils/Pretty.hs | 83 ++++++++++++++++++++++++++++++++++- clash/CLasH/VHDL/VHDLTools.hs | 10 ++++- 2 files changed, 90 insertions(+), 3 deletions(-) diff --git a/clash/CLasH/Utils/Pretty.hs b/clash/CLasH/Utils/Pretty.hs index df78ad9..17e332e 100644 --- a/clash/CLasH/Utils/Pretty.hs +++ b/clash/CLasH/Utils/Pretty.hs @@ -1,8 +1,10 @@ -module CLasH.Utils.Pretty (prettyShow, pprString, pprStringDebug) where +module CLasH.Utils.Pretty (prettyShow, pprString, pprStringDebug, zEncodeString) where -- Standard imports import qualified Data.Map as Map import Text.PrettyPrint.HughesPJClass +import Data.Char +import Numeric -- GHC API import qualified CoreSyn @@ -79,3 +81,82 @@ pprString = showSDoc . ppr pprStringDebug :: (Outputable x) => x -> String pprStringDebug = showSDocDebug . ppr + + +type UserString = String -- As the user typed it +type EncodedString = String -- Encoded form + +zEncodeString :: UserString -> EncodedString +zEncodeString cs = case maybe_tuple cs of + Just n -> n ++ (go cs) -- Tuples go to Z2T etc + Nothing -> go cs + where + go [] = [] + go (c:cs) = encode_digit_ch c ++ go' cs + go' [] = [] + go' (c:cs) = encode_ch c ++ go' cs + +maybe_tuple :: UserString -> Maybe EncodedString + +maybe_tuple "(# #)" = Just("Z1H") +maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of + (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) "H") + _ -> Nothing +maybe_tuple "()" = Just("Z0T") +maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of + (n, ')' : _) -> Just ('Z' : shows (n+1) "T") + _ -> Nothing +maybe_tuple _ = Nothing + +count_commas :: Int -> String -> (Int, String) +count_commas n (',' : cs) = count_commas (n+1) cs +count_commas n cs = (n,cs) + +encode_digit_ch :: Char -> EncodedString +encode_digit_ch c | c >= '0' && c <= '9' = encode_as_unicode_char c +encode_digit_ch c | otherwise = encode_ch c + +encode_ch :: Char -> EncodedString +encode_ch c | unencodedChar c = [c] -- Common case first + +-- Constructors +encode_ch '(' = "ZL" -- Needed for things like (,), and (->) +encode_ch ')' = "ZR" -- For symmetry with ( +encode_ch '[' = "ZM" +encode_ch ']' = "ZN" +encode_ch ':' = "ZC" +encode_ch 'Z' = "ZZ" + +-- Variables +encode_ch 'z' = "zz" +encode_ch '&' = "za" +encode_ch '|' = "zb" +encode_ch '^' = "zc" +encode_ch '$' = "zd" +encode_ch '=' = "ze" +encode_ch '>' = "zg" +encode_ch '#' = "zh" +encode_ch '.' = "zi" +encode_ch '<' = "zl" +encode_ch '-' = "zm" +encode_ch '!' = "zn" +encode_ch '+' = "zp" +encode_ch '\'' = "zq" +encode_ch '\\' = "zr" +encode_ch '/' = "zs" +encode_ch '*' = "zt" +encode_ch '%' = "zv" +encode_ch c = encode_as_unicode_char c + +encode_as_unicode_char :: Char -> EncodedString +encode_as_unicode_char c = 'z' : if isDigit (head hex_str) then hex_str + else '0':hex_str + where hex_str = showHex (ord c) "U" + +unencodedChar :: Char -> Bool -- True for chars that don't need encoding +unencodedChar 'Z' = False +unencodedChar 'z' = False +unencodedChar c = c >= 'a' && c <= 'z' + || c >= 'A' && c <= 'Z' + || c >= '0' && c <= '9' + || c == '_' \ No newline at end of file diff --git a/clash/CLasH/VHDL/VHDLTools.hs b/clash/CLasH/VHDL/VHDLTools.hs index 70b09ca..f04c1dc 100644 --- a/clash/CLasH/VHDL/VHDLTools.hs +++ b/clash/CLasH/VHDL/VHDLTools.hs @@ -256,12 +256,18 @@ mkVHDLBasicId s = -- basic ids. -- Use extended Ids for any values that are taken from the source file. mkVHDLExtId :: String -> AST.VHDLId -mkVHDLExtId s = - AST.unsafeVHDLExtId $ strip_invalid s +mkVHDLExtId s = + (AST.unsafeVHDLBasicId . zEncodeString . strip_multiscore . strip_leading . strip_invalid) s where -- Allowed characters, taken from ForSyde's mkVHDLExtId allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&'()*+,./:;<=>_|!$%@?[]^`{}~-" strip_invalid = filter (`elem` allowed) + strip_leading = dropWhile (`elem` ['0'..'9'] ++ "_") + strip_multiscore = concatMap (\cs -> + case cs of + ('_':_) -> "_" + _ -> cs + ) . List.group -- Create a record field selector that selects the given label from the record -- stored in the given binder. -- 2.30.2