From b2967df7f237e5b4db15d069895ca01c31712d9e Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 15 Jul 2009 20:11:44 +0200 Subject: [PATCH] Adepted the modules to their new structure --- .../CLasH/Normalize.hs" | 12 +-- .../CLasH/Normalize/NormalizeTools.hs" | 10 +-- .../CLasH/Normalize/NormalizeTypes.hs" | 8 +- .../CLasH/Translator.hs" | 16 ++-- .../CLasH/Translator/TranslatorTypes.hs" | 14 +--- "c\316\273ash/CLasH/Utils/Core/CoreShow.hs" | 2 +- "c\316\273ash/CLasH/Utils/Core/CoreTools.hs" | 8 +- "c\316\273ash/CLasH/Utils/GhcTools.hs" | 2 +- "c\316\273ash/CLasH/Utils/HsTools.hs" | 6 +- "c\316\273ash/CLasH/Utils/Pretty.hs" | 83 ++----------------- .../VHDL.hs" => "c\316\273ash/CLasH/VHDL.hs" | 14 ++-- "c\316\273ash/CLasH/VHDL/Constants.hs" | 2 +- "c\316\273ash/CLasH/VHDL/Generate.hs" | 12 +-- "c\316\273ash/CLasH/VHDL/VHDLTools.hs" | 10 +-- "c\316\273ash/CLasH/VHDL/VHDLTypes.hs" | 2 +- "c\316\273ash/c\316\273ash.cabal" | 61 +++++++++----- 16 files changed, 97 insertions(+), 165 deletions(-) rename "c\316\273ash/CLasH/Normalize/Normalize.hs" => "c\316\273ash/CLasH/Normalize.hs" (99%) rename "c\316\273ash/CLasH/Translator/Translator.hs" => "c\316\273ash/CLasH/Translator.hs" (98%) rename "c\316\273ash/CLasH/VHDL/VHDL.hs" => "c\316\273ash/CLasH/VHDL.hs" (98%) diff --git "a/c\316\273ash/CLasH/Normalize/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs" similarity index 99% rename from "c\316\273ash/CLasH/Normalize/Normalize.hs" rename to "c\316\273ash/CLasH/Normalize.hs" index 12356e2..7224610 100644 --- "a/c\316\273ash/CLasH/Normalize/Normalize.hs" +++ "b/c\316\273ash/CLasH/Normalize.hs" @@ -4,7 +4,7 @@ -- top level function "normalize", and defines the actual transformation passes that -- are performed. -- -module Normalize (normalizeModule) where +module CLasH.Normalize (normalizeModule) where -- Standard modules import Debug.Trace @@ -33,11 +33,11 @@ import qualified HscTypes import Outputable ( showSDoc, ppr, nest ) -- Local imports -import NormalizeTypes -import NormalizeTools -import VHDLTypes -import CoreTools -import Pretty +import CLasH.Normalize.NormalizeTypes +import CLasH.Normalize.NormalizeTools +import CLasH.VHDL.VHDLTypes +import CLasH.Utils.Core.CoreTools +import CLasH.Utils.Pretty -------------------------------- -- Start of transformations diff --git "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" index 920d28b..e1b8727 100644 --- "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" +++ "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" @@ -2,7 +2,7 @@ -- -- This module provides functions for program transformations. -- -module NormalizeTools where +module CLasH.Normalize.NormalizeTools where -- Standard modules import Debug.Trace import qualified List @@ -34,10 +34,10 @@ import qualified HscTypes import Outputable ( showSDoc, ppr, nest ) -- Local imports -import NormalizeTypes -import Pretty -import VHDLTypes -import qualified VHDLTools +import CLasH.Normalize.NormalizeTypes +import CLasH.Utils.Pretty +import CLasH.VHDL.VHDLTypes +import qualified CLasH.VHDL.VHDLTools as VHDLTools -- Create a new internal var with the given name and type. A Unique is -- appended to the given name, to ensure uniqueness (not strictly neccesary, diff --git "a/c\316\273ash/CLasH/Normalize/NormalizeTypes.hs" "b/c\316\273ash/CLasH/Normalize/NormalizeTypes.hs" index 56cba91..90589f8 100644 --- "a/c\316\273ash/CLasH/Normalize/NormalizeTypes.hs" +++ "b/c\316\273ash/CLasH/Normalize/NormalizeTypes.hs" @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -module NormalizeTypes where +module CLasH.Normalize.NormalizeTypes where -- Standard modules @@ -18,9 +18,9 @@ import qualified VarSet import Outputable ( Outputable, showSDoc, ppr ) -- Local imports -import CoreShow -import Pretty -import VHDLTypes -- For TypeState +import CLasH.Utils.Core.CoreShow +import CLasH.Utils.Pretty +import CLasH.VHDL.VHDLTypes -- For TypeState data TransformState = TransformState { tsUniqSupply_ :: UniqSupply.UniqSupply diff --git "a/c\316\273ash/CLasH/Translator/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs" similarity index 98% rename from "c\316\273ash/CLasH/Translator/Translator.hs" rename to "c\316\273ash/CLasH/Translator.hs" index 260b1cd..7203296 100644 --- "a/c\316\273ash/CLasH/Translator/Translator.hs" +++ "b/c\316\273ash/CLasH/Translator.hs" @@ -1,4 +1,5 @@ -module Translator where +module CLasH.Translator where + import qualified Directory import qualified System.FilePath as FilePath import qualified List @@ -43,14 +44,11 @@ import qualified Language.VHDL.Ppr as Ppr -- This is needed for rendering the pretty printed VHDL import Text.PrettyPrint.HughesPJ (render) -import TranslatorTypes -import HsValueMap -import Pretty -import Normalize --- import Flatten --- import FlattenTypes -import VHDLTypes -import qualified VHDL +import CLasH.Translator.TranslatorTypes +import CLasH.Utils.Pretty +import CLasH.Normalize +import CLasH.VHDL.VHDLTypes +import qualified CLasH.VHDL as VHDL makeVHDL :: String -> String -> Bool -> IO () makeVHDL filename name stateful = do diff --git "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" index 1286a41..0ab3b87 100644 --- "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" +++ "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" @@ -3,7 +3,7 @@ -- separate module to prevent circular dependencies in Pretty for example. -- {-# LANGUAGE TemplateHaskell #-} -module TranslatorTypes where +module CLasH.Translator.TranslatorTypes where import qualified Control.Monad.Trans.State as State import qualified Data.Map as Map @@ -14,19 +14,11 @@ import qualified HscTypes import qualified Language.VHDL.AST as AST -import FlattenTypes -import VHDLTypes -import HsValueMap - - --- | A map from a HsFunction identifier to various stuff we collect about a --- function along the way. -type FlatFuncMap = Map.Map HsFunction FlatFunction +import CLasH.VHDL.VHDLTypes data TranslatorSession = TranslatorSession { tsCoreModule_ :: HscTypes.CoreModule, -- ^ The current module - tsNameCount_ :: Int, -- ^ A counter that can be used to generate unique names - tsFlatFuncs_ :: FlatFuncMap -- ^ A map from HsFunction to FlatFunction + tsNameCount_ :: Int -- ^ A counter that can be used to generate unique names } -- Derive accessors diff --git "a/c\316\273ash/CLasH/Utils/Core/CoreShow.hs" "b/c\316\273ash/CLasH/Utils/Core/CoreShow.hs" index 09abed6..192ecc8 100644 --- "a/c\316\273ash/CLasH/Utils/Core/CoreShow.hs" +++ "b/c\316\273ash/CLasH/Utils/Core/CoreShow.hs" @@ -1,5 +1,5 @@ {-# LANGUAGE StandaloneDeriving,FlexibleInstances, UndecidableInstances, OverlappingInstances #-} -module CoreShow where +module CLasH.Utils.Core.CoreShow where -- This module derives Show instances for CoreSyn types. diff --git "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" index 0c0e1fa..45721a8 100644 --- "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" +++ "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" @@ -2,7 +2,7 @@ -- programs. This module does not provide the actual plumbing to work with -- Core and Haskell (it uses HsTools for this), but only the functions that -- know about various libraries and know which functions to call. -module CoreTools where +module CLasH.Utils.Core.CoreTools where --Standard modules import qualified Maybe @@ -32,9 +32,9 @@ import qualified CoreFVs import qualified Literal -- Local imports -import GhcTools -import HsTools -import Pretty +import CLasH.Utils.GhcTools +import CLasH.Utils.HsTools +import CLasH.Utils.Pretty -- | Evaluate a core Type representing type level int from the tfp -- library to a real int. diff --git "a/c\316\273ash/CLasH/Utils/GhcTools.hs" "b/c\316\273ash/CLasH/Utils/GhcTools.hs" index 9c5038c..5f6e671 100644 --- "a/c\316\273ash/CLasH/Utils/GhcTools.hs" +++ "b/c\316\273ash/CLasH/Utils/GhcTools.hs" @@ -1,4 +1,4 @@ -module GhcTools where +module CLasH.Utils.GhcTools where -- Standard modules import qualified System.IO.Unsafe diff --git "a/c\316\273ash/CLasH/Utils/HsTools.hs" "b/c\316\273ash/CLasH/Utils/HsTools.hs" index 1bad941..ca20441 100644 --- "a/c\316\273ash/CLasH/Utils/HsTools.hs" +++ "b/c\316\273ash/CLasH/Utils/HsTools.hs" @@ -1,5 +1,5 @@ {-# LANGUAGE ViewPatterns #-} -module HsTools where +module CLasH.Utils.HsTools where -- Standard modules import qualified Unsafe.Coerce @@ -53,8 +53,8 @@ import qualified TyCon -- Local imports -import GhcTools -import CoreShow +import CLasH.Utils.GhcTools +import CLasH.Utils.Core.CoreShow -- | Translate a HsExpr to a Core expression. This does renaming, type -- checking, simplification of class instances and desugaring. The result is diff --git "a/c\316\273ash/CLasH/Utils/Pretty.hs" "b/c\316\273ash/CLasH/Utils/Pretty.hs" index d88846a..4366b10 100644 --- "a/c\316\273ash/CLasH/Utils/Pretty.hs" +++ "b/c\316\273ash/CLasH/Utils/Pretty.hs" @@ -1,4 +1,4 @@ -module Pretty (prettyShow, pprString, pprStringDebug) where +module CLasH.Utils.Pretty (prettyShow, pprString, pprStringDebug) where import qualified Data.Map as Map @@ -15,92 +15,19 @@ import qualified Language.VHDL.Ppr as Ppr import qualified Language.VHDL.AST as AST import qualified Language.VHDL.AST.Ppr -import HsValueMap -import FlattenTypes -import TranslatorTypes -import VHDLTypes -import CoreShow +import CLasH.Translator.TranslatorTypes +import CLasH.VHDL.VHDLTypes +import CLasH.Utils.Core.CoreShow -- | A version of the default pPrintList method, which uses a custom function -- f instead of pPrint to print elements. printList :: (a -> Doc) -> [a] -> Doc printList f = brackets . fsep . punctuate comma . map f -instance Pretty HsFunction where - pPrint (HsFunction name args res) = - text name <> char ' ' <> parens (hsep $ punctuate comma args') <> text " -> " <> res' - where - args' = map pPrint args - res' = pPrint res - -instance Pretty x => Pretty (HsValueMap x) where - pPrint (Tuple maps) = parens (hsep $ punctuate comma (map pPrint maps)) - pPrint (Single s) = pPrint s - -instance Pretty HsValueUse where - pPrint Port = char 'P' - pPrint (State n) = char 'S' <> int n - pPrint (HighOrder _ _) = text "Higher Order" - -instance Pretty FlatFunction where - pPrint (FlatFunction args res defs sigs) = - (text "Args: ") $$ nest 10 (pPrint args) - $+$ (text "Result: ") $$ nest 10 (pPrint res) - $+$ (text "Defs: ") $$ nest 10 (ppdefs defs) - $+$ text "Signals: " $$ nest 10 (ppsigs sigs) - where - ppsig (id, info) = pPrint id <> pPrint info - ppdefs defs = vcat (map pPrint sorted) - where - -- Roughly sort the entries (inaccurate for Fapps) - sorted = List.sortBy (\a b -> compare (sigDefDst a) (sigDefDst b)) defs - sigDefDst (FApp _ _ dst) = head $ Foldable.toList dst - sigDefDst (CondDef _ _ _ dst) = dst - sigDefDst (UncondDef _ dst) = dst - ppsigs sigs = vcat (map pPrint sorted) - where - sorted = List.sortBy (\a b -> compare (fst a) (fst b)) sigs - - -instance Pretty SigDef where - pPrint (FApp func args res) = - pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res - pPrint (CondDef cond true false res) = - pPrint cond <> text " ? " <> pPrint true <> text " : " <> pPrint false <> text " -> " <> pPrint res - pPrint (UncondDef src dst) = - ppsrc src <> text " -> " <> pPrint dst - where - ppsrc (Left id) = pPrint id - ppsrc (Right expr) = pPrint expr - -instance Pretty SignalExpr where - pPrint (EqLit id lit) = - parens $ pPrint id <> text " = " <> text lit - pPrint (Literal lit ty) = - text "(" <> text (show ty) <> text ") " <> text lit - pPrint (Eq a b) = - parens $ pPrint a <> text " = " <> pPrint b - -instance Pretty SignalInfo where - pPrint (SignalInfo name use ty hints) = - text ":" <> (pPrint use) <> (ppname name) - where - ppname Nothing = empty - ppname (Just name) = text ":" <> text name - -instance Pretty SigUse where - pPrint SigPortIn = text "PI" - pPrint SigPortOut = text "PO" - pPrint SigInternal = text "I" - pPrint (SigStateOld n) = text "SO:" <> int n - pPrint (SigStateNew n) = text "SN:" <> int n - pPrint SigSubState = text "s" - instance Pretty TranslatorSession where - pPrint (TranslatorSession mod nameCount flatfuncs) = + pPrint (TranslatorSession mod nameCount) = text "Module: " $$ nest 15 (text modname) $+$ text "NameCount: " $$ nest 15 (int nameCount) - $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList flatfuncs))) where ppfunc (hsfunc, flatfunc) = pPrint hsfunc $+$ nest 5 (pPrint flatfunc) diff --git "a/c\316\273ash/CLasH/VHDL/VHDL.hs" "b/c\316\273ash/CLasH/VHDL.hs" similarity index 98% rename from "c\316\273ash/CLasH/VHDL/VHDL.hs" rename to "c\316\273ash/CLasH/VHDL.hs" index 1a8f394..031acc8 100644 --- "a/c\316\273ash/CLasH/VHDL/VHDL.hs" +++ "b/c\316\273ash/CLasH/VHDL.hs" @@ -1,7 +1,7 @@ -- -- Functions to generate VHDL from FlatFunctions -- -module VHDL where +module CLasH.VHDL where -- Standard modules import qualified Data.List as List @@ -32,12 +32,12 @@ import qualified CoreUtils import Outputable ( showSDoc, ppr ) -- Local imports -import VHDLTypes -import VHDLTools -import Pretty -import CoreTools -import Constants -import Generate +import CLasH.VHDL.VHDLTypes +import CLasH.VHDL.VHDLTools +import CLasH.Utils.Pretty +import CLasH.Utils.Core.CoreTools +import CLasH.VHDL.Constants +import CLasH.VHDL.Generate createDesignFiles :: TypeState diff --git "a/c\316\273ash/CLasH/VHDL/Constants.hs" "b/c\316\273ash/CLasH/VHDL/Constants.hs" index e9c4a4a..317cb64 100644 --- "a/c\316\273ash/CLasH/VHDL/Constants.hs" +++ "b/c\316\273ash/CLasH/VHDL/Constants.hs" @@ -1,4 +1,4 @@ -module Constants where +module CLasH.VHDL.Constants where import qualified Language.VHDL.AST as AST diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index 8dc7a0a..2c5f2d7 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -1,6 +1,6 @@ {-# LANGUAGE PackageImports #-} -module Generate where +module CLasH.VHDL.Generate where -- Standard modules import qualified Control.Monad as Monad @@ -26,11 +26,11 @@ import qualified Name import qualified TyCon -- Local imports -import Constants -import VHDLTypes -import VHDLTools -import CoreTools -import Pretty +import CLasH.VHDL.Constants +import CLasH.VHDL.VHDLTypes +import CLasH.VHDL.VHDLTools +import CLasH.Utils.Core.CoreTools +import CLasH.Utils.Pretty ----------------------------------------------------------------------------- -- Functions to generate VHDL for builtin functions diff --git "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" index 6e6a0c4..8fd9938 100644 --- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" +++ "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" @@ -1,4 +1,4 @@ -module VHDLTools where +module CLasH.VHDL.VHDLTools where -- Standard modules import qualified Maybe @@ -28,10 +28,10 @@ import qualified DataCon import qualified CoreSubst -- Local imports -import VHDLTypes -import CoreTools -import Pretty -import Constants +import CLasH.VHDL.VHDLTypes +import CLasH.Utils.Core.CoreTools +import CLasH.Utils.Pretty +import CLasH.VHDL.Constants ----------------------------------------------------------------------------- -- Functions to generate concurrent statements diff --git "a/c\316\273ash/CLasH/VHDL/VHDLTypes.hs" "b/c\316\273ash/CLasH/VHDL/VHDLTypes.hs" index 8712043..52adab7 100644 --- "a/c\316\273ash/CLasH/VHDL/VHDLTypes.hs" +++ "b/c\316\273ash/CLasH/VHDL/VHDLTypes.hs" @@ -2,7 +2,7 @@ -- Some types used by the VHDL module. -- {-# LANGUAGE TemplateHaskell #-} -module VHDLTypes where +module CLasH.VHDL.VHDLTypes where -- Standard imports import qualified Control.Monad.Trans.State as State diff --git "a/c\316\273ash/c\316\273ash.cabal" "b/c\316\273ash/c\316\273ash.cabal" index 3eb5dca..23af8fb 100644 --- "a/c\316\273ash/c\316\273ash.cabal" +++ "b/c\316\273ash/c\316\273ash.cabal" @@ -1,24 +1,39 @@ -name: clash -version: 0.1 -build-type: Simple -synopsis: CAES Languege for Hardware Descriptions (CλasH) -description: CλasH is a toolchain/language to translate subsets of - Haskell to synthesizable VHDL. It does this by - translating the intermediate System Fc (GHC Core) - representation to a VHDL AST, which is then written to - file. -category: Development -license: BSD3 -license-file: LICENSE -package-url: http://github.com/darchon/clash/tree/master -copyright: Copyright (c) 2009 Christiaan Baaij & Matthijs Kooijman -author: Christiaan Baaij & Matthijs Kooijman -stability: alpha -maintainer: christiaan.baaij@gmail.com & matthijs@stdin.nl -build-depends: ghc >= 6.11, vhdl, data-accessor-template, data-accessor, - containers, transformers, base >= 4, haskell98, - prettyclass, ghc-paths, pretty, syb, filepath, - th-lift-ng, tfp > 0.3.2, tfvec > 0.1.2 +name: clash +version: 0.1 +build-type: Simple +synopsis: CAES Languege for Hardware Descriptions (CλasH) +description: CλasH is a toolchain/language to translate subsets of + Haskell to synthesizable VHDL. It does this by translating + the intermediate System Fc (GHC Core) representation to a + VHDL AST, which is then written to file. +category: Development +license: BSD3 +license-file: LICENSE +package-url: http://github.com/darchon/clash/tree/master +copyright: Copyright (c) 2009 Christiaan Baaij & Matthijs Kooijman +author: Christiaan Baaij & Matthijs Kooijman +stability: alpha +maintainer: christiaan.baaij@gmail.com & matthijs@stdin.nl +Cabal-Version: >= 1.2 -executable: clash -main-is: Main.hs +Library + build-depends: ghc >= 6.11, vhdl, data-accessor-template, data-accessor, + containers, transformers, base >= 4, haskell98, + prettyclass, ghc-paths, pretty, syb, filepath, th-lift-ng, + tfp > 0.3.2, tfvec > 0.1.2 + exposed-modules: CLasH.Translator + other-modules: CLasH.Translator.TranslatorTypes + CLasH.Normalize + CLasH.Normalize.NormalizeTypes + CLasH.Normalize.NormalizeTools + CLasH.VHDL + CLasH.VHDL.Constants + CLasH.VHDL.Generate + CLasH.VHDL.VHDLTools + CLasH.VHDL.VHDLTypes + CLasH.Utils.GhcTools + CLasH.Utils.HsTools + CLasH.Utils.Pretty + CLasH.Utils.Core.CoreShow + CLasH.Utils.Core.CoreTools + \ No newline at end of file -- 2.30.2