hardware-edsl 0.1.0.0 → 0.1.0.1

raw patch · 7 files changed

+81/−13 lines, 7 files

Files

hardware-edsl.cabal +1/−1
src/Language/Embedded/Hardware/Command.hs +19/−0
src/Language/Embedded/Hardware/Command/Backend/VHDL.hs +12/−6
src/Language/Embedded/Hardware/Command/CMD.hs +3/−1
src/Language/Embedded/Hardware/Expression/Represent.hs +20/−0
src/Language/Embedded/VHDL/Monad.hs +13/−5
src/Language/Embedded/VHDL/Monad/Type.hs +13/−0

hardware-edsl.cabal view

@@ -1,5 +1,5 @@ name:                hardware-edsl-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Deep embedding of hardware descriptions with code generation. description:         Deep embedding of hardware descriptions with code generation. license:             BSD3

src/Language/Embedded/Hardware/Command.hs view

@@ -5,6 +5,8 @@   , icompile   , runIO +  , wcompile+   , module CMD   , module Language.Embedded.Hardware.Command.CMD   , module Language.Embedded.Hardware.Command.Frontend@@ -18,6 +20,9 @@  import Language.Embedded.VHDL (VHDL, prettyVHDL) +import qualified Language.VHDL          as VHDL -- temp+import qualified Language.Embedded.VHDL as VHDL -- temp+ import Control.Monad.Operational.Higher  --------------------------------------------------------------------------------@@ -35,5 +40,19 @@ -- | Run a program in 'IO'. runIO :: (Interp instr IO, HFunctor instr) => Program instr a -> IO a runIO = interpret++--------------------------------------------------------------------------------++-- | Temp.+wcompile :: (Interp instr VHDL, HFunctor instr) => Program instr () -> IO ()+wcompile = putStrLn . show . prettyVHDL . wrap . interpret+  where+    wrap :: VHDL () -> VHDL ()+    wrap v = do+      VHDL.entity (VHDL.Ident "empty") (return ())+      VHDL.architecture (VHDL.Ident "empty") (VHDL.Ident "behavioural") $+        do l <- VHDL.newLabel+           s <- snd <$> VHDL.inProcess l [] v+           VHDL.addConcurrent $ VHDL.ConProcess s  --------------------------------------------------------------------------------

src/Language/Embedded/Hardware/Command/Backend/VHDL.hs view

@@ -183,10 +183,10 @@         return v  runArray :: forall exp prog a. EvaluateExp exp => ArrayCMD exp prog a -> IO a-runArray (NewArray len)            = fmap ArrayE $ IA.newArray_ $ (,) 0 $ evalE len-runArray (InitArray is)            = fmap ArrayE $ IA.newListArray (0, fromIntegral $ length is) is-runArray (GetArray i (ArrayE a))   = fmap litE $ IA.readArray a $ evalE i-runArray (SetArray i e (ArrayE a)) = IA.writeArray a (evalE i) (evalE e)+runArray (NewArray len)            = fmap ArrayE . IR.newIORef =<< IA.newArray_ (0, evalE len)+runArray (InitArray is)            = fmap ArrayE . IR.newIORef =<< IA.newListArray (0, fromIntegral $ length is) is+runArray (GetArray i (ArrayE a))   = do r <- IR.readIORef a; fmap litE $ IA.readArray r (evalE i)+runArray (SetArray i e (ArrayE a)) = do r <- IR.readIORef a; IA.writeArray r (evalE i) (evalE e) runArray (UnsafeGetArray i a)      = runArray (GetArray i a)  --------------------------------------------------------------------------------@@ -226,8 +226,14 @@      (v, i) <- freshVar      loop   <- V.inFor i (V.range zero V.to (lift hi)) (step v)      V.addSequential $ V.SLoop $ loop-compileLoop (While b step) =-  do error "todo: compile while loops"+compileLoop (While cont step) =+  do l    <- V.newLabel+     loop <- V.inWhile l (Nothing) $+       do b    <- cont+          exit <- compE b+          V.exit l exit+          step+     V.addSequential $ V.SLoop $ loop  runLoop :: forall exp prog a. EvaluateExp exp => LoopCMD exp IO a -> IO a runLoop (For r step) = loop (evalE r)

src/Language/Embedded/Hardware/Command/CMD.hs view

@@ -54,6 +54,7 @@     hfmap _ (NewSignal c s m e) = NewSignal c s m e     hfmap _ (GetSignal s)       = GetSignal s     hfmap _ (SetSignal s e)     = SetSignal s e+    hfmap _ (UnsafeFreezeSignal s) = UnsafeFreezeSignal s  -------------------------------------------------------------------------------- -- ** Variables.@@ -81,6 +82,7 @@     hfmap _ (NewVariable e)   = NewVariable e     hfmap _ (GetVariable s)   = GetVariable s     hfmap _ (SetVariable s e) = SetVariable s e+    hfmap _ (UnsafeFreezeVariable s) = UnsafeFreezeVariable s  -------------------------------------------------------------------------------- -- ** Arrays.@@ -93,7 +95,7 @@     compArrayIx _ _ = Nothing  -- | Array reprensentation.-data Array i a = ArrayC Integer | ArrayE (IOArray i a)+data Array i a = ArrayC Integer | ArrayE (IORef (IOArray i a))  -- | Commands for arrays. data ArrayCMD (exp :: * -> *) (prog :: * -> *) a

src/Language/Embedded/Hardware/Expression/Represent.hs view

@@ -44,6 +44,11 @@      newImport  "IEEE.std_logic_1164"      newImport  "IEEE.numeric_std" +declareFloating :: VHDL ()+declareFloating =+  do newLibrary "IEEE"+     newImport  "IEEE.float_pkg"+ -------------------------------------------------------------------------------- -- ** Boolean @@ -107,6 +112,21 @@   typed     = Tag usigned64   declare _ = declareNumeric   format    = convert++--------------------------------------------------------------------------------+-- ** Floating point.++instance Rep Float where+  width     = Tag 32+  typed     = Tag float+  declare _ = declareFloating+  format    = error "todo: format float."++instance Rep Double where+  width     = Tag 64+  typed     = Tag double+  declare _ = declareFloating+  format    = error "todo: format double."  -------------------------------------------------------------------------------- -- * Converting Integers to their Binrary representation

src/Language/Embedded/VHDL/Monad.hs view

@@ -31,6 +31,7 @@      -- ^ statements   , inProcess, inFor, inWhile, inConditional, inCase+  , exit      -- ^ structures   , entity, architecture, package@@ -244,18 +245,25 @@          (newSequential)  -- | Run program inside while loop.-inWhile :: MonadV m => Expression -> m () -> m (LoopStatement)-inWhile cont m =+inWhile :: MonadV m => Label -> Maybe Expression -> m () -> m (LoopStatement)+inWhile l cont m =   do oldSequential <- CMS.gets _sequential      CMS.modify $ \e -> e { _sequential = [] }      m      newSequential <- reverse <$> CMS.gets _sequential      CMS.modify $ \e -> e { _sequential = oldSequential }-     return $+     return $         LoopStatement-         (Nothing)-         (Just (IterWhile cont))+         (Just l)+         (iter cont)          (newSequential)+  where+    iter :: Maybe Expression -> Maybe IterationScheme+    iter = maybe (Nothing) (Just . IterWhile)++-- | Exit loop.+exit :: MonadV m => Label -> Expression -> m ()+exit label e = addSequential $ SExit $ ExitStatement (Nothing) (Just label) (Just e)  -- | Conditional statements. inConditional :: MonadV m => (Condition, m ()) -> [(Condition, m ())] -> m () -> m (IfStatement)

src/Language/Embedded/VHDL/Monad/Type.hs view

@@ -5,6 +5,7 @@   , std_logic   , signed8,  signed16,  signed32,  signed64   , usigned8, usigned16, usigned32, usigned64+  , float, double   ) where  import Language.VHDL@@ -55,6 +56,18 @@ usigned16 = usigned 16 usigned32 = usigned 32 usigned64 = usigned 64++--------------------------------------------------------------------------------+-- ** Floating point.++floating :: Int -> Type+floating size = SubtypeIndication Nothing+  (TMType (NSimple (Ident ("float" ++ show size))))+  (Nothing)++float, double :: Type+float  = floating 32+double = floating 64  -- .. add more .. --------------------------------------------------------------------------------