From c8676a7aec4420d558936beedfb578479c4575cf Mon Sep 17 00:00:00 2001
From: christiaanb <christiaan.baaij@gmail.com>
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