Remove getDesignFiles from the VHDLState monad.

[matthijs/master-project/cλash.git] / VHDL.hs

diff --git a/VHDL.hs b/VHDL.hs
index f5ab7cd25cd23046d6e95887036c6f50d3e51331..d9dce9e699f9188dfefc9726f625a7369bc7cd29 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -4,6 +4,7 @@
 module VHDL where
 
 import qualified Data.Foldable as Foldable
+import qualified Data.List as List
 import qualified Maybe
 import qualified Control.Monad as Monad
 import qualified Control.Arrow as Arrow
@@ -24,16 +25,14 @@ import FlattenTypes
 import TranslatorTypes
 import Pretty
 
-getDesignFiles :: VHDLState [AST.DesignFile]
-getDesignFiles = do
-  -- Extract the library units generated from all the functions in the
-  -- session.
-  funcs <- getFuncs
-  let units = Maybe.mapMaybe getLibraryUnits funcs
-  let context = [
-        AST.Library $ mkVHDLId "IEEE",
-        AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All]
-  return $ map (AST.DesignFile context) units
+getDesignFiles :: [FuncData] -> [AST.DesignFile]
+getDesignFiles funcs =
+  map (AST.DesignFile context) units
+  where
+    units = filter (not.null) $ map getLibraryUnits funcs
+    context = [
+      AST.Library $ mkVHDLId "IEEE",
+      AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All]
   
 -- | Create an entity for a given function
 createEntity ::
@@ -305,20 +304,19 @@ getEntityId fdata =
       Just (AST.EntityDec id _) -> Just id
 
 getLibraryUnits ::
-  (HsFunction, FuncData)      -- | A function from the session
-  -> Maybe [AST.LibraryUnit]  -- | The entity, architecture and optional package for the function
+  FuncData                    -- | A function from the session
+  -> [AST.LibraryUnit]  -- | The entity, architecture and optional package for the function
 
-getLibraryUnits (hsfunc, fdata) =
+getLibraryUnits fdata =
   case funcEntity fdata of 
-    Nothing -> Nothing
+    Nothing -> []
     Just ent -> 
       case ent_decl ent of
-      Nothing -> Nothing
+      Nothing -> []
       Just decl ->
         case funcArch fdata of
-          Nothing -> Nothing
+          Nothing -> []
           Just arch ->
-            Just $
               [AST.LUEntity decl, AST.LUArch arch]
               ++ (Maybe.maybeToList (fmap AST.LUPackageDec $ ent_pkg_decl ent))
 
@@ -371,7 +369,13 @@ vhdl_ty_maybe ty =
 -- Shortcut
 mkVHDLId :: String -> AST.VHDLId
 mkVHDLId s = 
-  AST.unsafeVHDLBasicId s'
+  AST.unsafeVHDLBasicId $ (strip_multiscore . strip_invalid) s
   where
     -- Strip invalid characters.
-    s' = filter (`elem` ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_.") s
+    strip_invalid = filter (`elem` ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_.")
+    -- Strip multiple adjacent underscores
+    strip_multiscore = concat . map (\cs -> 
+        case cs of 
+          ('_':_) -> "_"
+          _ -> cs
+      ) . List.group