X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL.hs;h=fd83899cee622a7ddc501afa598a87cc227e9eac;hb=da5bb0c8cfdc783b2801cef3bc8d875d3f5b6f53;hp=21452a9714c24379dcdc0017b719c5e0b04fb3f3;hpb=4c63601269c7097e2177c547dc36d4edecc1c648;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/VHDL.hs" "b/c\316\273ash/CLasH/VHDL.hs" index 21452a9..fd83899 100644 --- "a/c\316\273ash/CLasH/VHDL.hs" +++ "b/c\316\273ash/CLasH/VHDL.hs" @@ -57,10 +57,10 @@ createDesignFiles init_typestate binds topbind testinput = State.runState (createLibraryUnits binds) init_session (testbench, final_session) = State.runState (createTestBench Nothing testinput topbind) final_session' - tyfun_decls = map snd $ Map.elems (final_session ^. vsType ^. vsTypeFuns) + tyfun_decls = mkBuiltInShow ++ (map snd $ Map.elems (final_session ^. vsType ^. vsTypeFuns)) ty_decls = final_session ^. vsType ^. vsTypeDecls tfvec_index_decl = AST.PDISD $ AST.SubtypeDec tfvec_indexTM tfvec_index_def - tfvec_range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit "-1") (AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerTM) highId Nothing) + tfvec_range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit "-1") (AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerTM) (AST.NSimple $ highId) Nothing) tfvec_index_def = AST.SubtypeIn integerTM (Just tfvec_range) ieee_context = [ AST.Library $ mkVHDLBasicId "IEEE", @@ -103,8 +103,8 @@ createLibraryUnits binds = do -- | Create an entity for a given function createEntity :: - (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- | The function - -> VHDLSession AST.EntityDec -- | The resulting entity + (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The function + -> VHDLSession AST.EntityDec -- ^ The resulting entity createEntity (fname, expr) = do -- Strip off lambda's, these will be arguments @@ -139,12 +139,12 @@ createEntity (fname, expr) = do return (id, type_mark) ) - -- | Create the VHDL AST for an entity +-- | Create the VHDL AST for an entity createEntityAST :: - AST.VHDLId -- | The name of the function - -> [Port] -- | The entity's arguments - -> Port -- | The entity's result - -> AST.EntityDec -- | The entity with the ent_decl filled in as well + AST.VHDLId -- ^ The name of the function + -> [Port] -- ^ The entity's arguments + -> Port -- ^ The entity's result + -> AST.EntityDec -- ^ The entity with the ent_decl filled in as well createEntityAST vhdl_id args res = AST.EntityDec vhdl_id ports @@ -154,13 +154,13 @@ createEntityAST vhdl_id args res = ++ [mkIfaceSigDec AST.Out res] ++ [clk_port] -- Add a clk port if we have state - clk_port = AST.IfaceSigDec (mkVHDLExtId "clk") AST.In std_logicTM + clk_port = AST.IfaceSigDec clockId AST.In std_logicTM -- | Create a port declaration mkIfaceSigDec :: - AST.Mode -- | The mode for the port (In / Out) - -> (AST.VHDLId, AST.TypeMark) -- | The id and type for the port - -> AST.IfaceSigDec -- | The resulting port declaration + AST.Mode -- ^ The mode for the port (In / Out) + -> (AST.VHDLId, AST.TypeMark) -- ^ The id and type for the port + -> AST.IfaceSigDec -- ^ The resulting port declaration mkIfaceSigDec mode (id, ty) = AST.IfaceSigDec id mode ty @@ -240,15 +240,6 @@ getSignalId info = (error $ "Unnamed signal? This should not happen!") (sigName info) -} - -mkSigDec :: CoreSyn.CoreBndr -> VHDLSession (Maybe AST.SigDec) -mkSigDec bndr = - if True then do --isInternalSigUse use || isStateSigUse use then do - let error_msg = "\nVHDL.mkSigDec: Can not make signal declaration for type: \n" ++ pprString bndr - type_mark <- MonadState.lift vsType $ vhdl_ty error_msg (Var.varType bndr) - return $ Just (AST.SigDec (varToVHDLId bndr) type_mark Nothing) - else - return Nothing -- | Transforms a core binding into a VHDL concurrent statement mkConcSm :: @@ -409,7 +400,7 @@ createOutputProc outs = [clockId] [AST.IfSm clkPred (writeOuts outs) [] Nothing] where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId) - eventId + (AST.NSimple $ eventId) Nothing ) `AST.And` (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'") writeOuts :: [AST.VHDLId] -> [AST.SeqSm] @@ -417,12 +408,6 @@ createOutputProc outs = writeOuts [i] = [writeOut i (AST.PrimLit "LF")] writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is writeOut outSig suffix = - genExprFCall2 writeId + genExprPCall2 writeId (AST.PrimName $ AST.NSimple outputId) - (genExprFCall1 showId ((AST.PrimName $ AST.NSimple outSig) AST.:&: suffix)) - genExprFCall2 entid arg1 arg2 = - AST.ProcCall (AST.NSimple entid) $ - map (\exp -> Nothing AST.:=>: AST.ADExpr exp) [arg1,arg2] - genExprFCall1 entid arg = - AST.PrimFCall $ AST.FCall (AST.NSimple entid) $ - map (\exp -> Nothing AST.:=>: AST.ADExpr exp) [arg] + ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)