X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=5618532c2f1771fd18d88ba417120072e94206fb;hb=68452976b782fcf291a678330ca3a9703e8c7c35;hp=2c5f2d7f57809c11ec6aa90144c84aae56873538;hpb=b2967df7f237e5b4db15d069895ca01c31712d9e;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index 2c5f2d7..5618532 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -1,14 +1,9 @@ -{-# LANGUAGE PackageImports #-} - module CLasH.VHDL.Generate where -- Standard modules -import qualified Control.Monad as Monad import qualified Data.Map as Map import qualified Maybe import qualified Data.Either as Either -import qualified Control.Monad.Trans.State as State -import qualified "transformers" Control.Monad.Identity as Identity import Data.Accessor import Data.Accessor.MonadState as MonadState import Debug.Trace @@ -17,8 +12,8 @@ import Debug.Trace import qualified Language.VHDL.AST as AST -- GHC API -import CoreSyn -import Type +import qualified CoreSyn +import qualified Type import qualified Var import qualified IdInfo import qualified Literal @@ -151,20 +146,97 @@ genFromInteger' (Left res) f lits = do { ; (tycon, args) = Type.splitTyConApp ty ; name = Name.getOccString (TyCon.tyConName tycon) } ; - ; len <- case name of - "SizedInt" -> MonadState.lift vsType $ tfp_to_int (sized_int_len_ty ty) - "SizedWord" -> MonadState.lift vsType $ tfp_to_int (sized_word_len_ty ty) - ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId - ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname)) - [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))] + ; case name of + "RangedWord" -> return $ AST.PrimLit (show (last lits)) + otherwise -> do { + ; len <- case name of + "SizedInt" -> MonadState.lift vsType $ tfp_to_int (sized_int_len_ty ty) + "SizedWord" -> MonadState.lift vsType $ tfp_to_int (sized_word_len_ty ty) + "RangedWord" -> MonadState.lift vsType $ tfp_to_int (ranged_word_bound_ty ty) + ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId + ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname)) + [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))] + } } genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name +genSizedInt :: BuiltinBuilder +genSizedInt = genFromInteger + +-- | Generate a Builder for the builtin datacon TFVec +genTFVec :: BuiltinBuilder +genTFVec (Left res) f [Left (CoreSyn.Let (CoreSyn.Rec letBinders) letRes)] = do { + -- Generate Assignments for all the binders + ; letAssigns <- mapM genBinderAssign letBinders + -- Generate assignments for the result (which might be another let binding) + ; (resBinders,resAssignments) <- genResAssign letRes + -- Get all the Assigned binders + ; let assignedBinders = Maybe.catMaybes (map fst letAssigns) + -- Make signal names for all the assigned binders + ; sigs <- mapM (\x -> MonadState.lift vsType $ varToVHDLExpr x) (assignedBinders ++ resBinders) + -- Assign all the signals to the resulting vector + ; let { vecsigns = mkAggregateSignal sigs + ; vecassign = mkUncondAssign (Left res) vecsigns + } ; + -- Generate all the signal declaration for the assigned binders + ; sig_dec_maybes <- mapM mkSigDec (assignedBinders ++ resBinders) + ; let { sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes) + -- Setup the VHDL Block + ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res)) + ; block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs ((concat (map snd letAssigns)) ++ resAssignments ++ [vecassign]) + } ; + -- Return the block statement coressponding to the TFVec literal + ; return $ [AST.CSBSm block] + } + where + genBinderAssign :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> VHDLSession (Maybe CoreSyn.CoreBndr, [AST.ConcSm]) + -- For now we only translate applications + genBinderAssign (bndr, app@(CoreSyn.App _ _)) = do + let (CoreSyn.Var f, args) = CoreSyn.collectArgs app + let valargs = get_val_args (Var.varType f) args + apps <- genApplication (Left bndr) f (map Left valargs) + return (Just bndr, apps) + genBinderAssign _ = return (Nothing,[]) + genResAssign :: CoreSyn.CoreExpr -> VHDLSession ([CoreSyn.CoreBndr], [AST.ConcSm]) + genResAssign app@(CoreSyn.App _ letexpr) = do + case letexpr of + (CoreSyn.Let (CoreSyn.Rec letbndrs) letres) -> do + letapps <- mapM genBinderAssign letbndrs + let bndrs = Maybe.catMaybes (map fst letapps) + let app = (map snd letapps) + (vars, apps) <- genResAssign letres + return ((bndrs ++ vars),((concat app) ++ apps)) + otherwise -> return ([],[]) + genResAssign _ = return ([],[]) + +genTFVec (Left res) f [Left app@(CoreSyn.App _ _)] = do { + ; let { elems = reduceCoreListToHsList app + -- Make signal names for all the binders + ; binders = map (\expr -> case expr of + (CoreSyn.Var b) -> b + otherwise -> error $ "\nGenerate.genTFVec: Cannot generate TFVec: " + ++ show res ++ ", with elems:\n" ++ show elems ++ "\n" ++ pprString elems) elems + } ; + ; sigs <- mapM (\x -> MonadState.lift vsType $ varToVHDLExpr x) binders + -- Assign all the signals to the resulting vector + ; let { vecsigns = mkAggregateSignal sigs + ; vecassign = mkUncondAssign (Left res) vecsigns + -- Setup the VHDL Block + ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res)) + ; block = AST.BlockSm block_label [] (AST.PMapAspect []) [] [vecassign] + } ; + -- Return the block statement coressponding to the TFVec literal + ; return $ [AST.CSBSm block] + } + +genTFVec (Left name) _ [Left xs] = error $ "\nGenerate.genTFVec: Cannot generate TFVec: " ++ show name ++ ", with elems:\n" ++ show xs ++ "\n" ++ pprString xs + +genTFVec (Right name) _ _ = error $ "\nGenerate.genTFVec: Cannot generate TFVec assigned to VHDLName: " ++ show name -- | Generate a generate statement for the builtin function "map" genMap :: BuiltinBuilder -genMap (Left res) f [Left mapped_f, Left (Var arg)] = do { +genMap (Left res) f [Left mapped_f, Left (CoreSyn.Var arg)] = do { -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since -- we must index it (which we couldn't if it was a VHDL Expr, since only @@ -240,7 +312,7 @@ genFold'' len left (Left res) f [folded_f, start, vec] = do -- An expression for len-1 let len_min_expr = (AST.PrimLit $ show (len-1)) -- evec is (TFVec n), so it still needs an element type - let (nvec, _) = splitAppTy (Var.varType vec) + let (nvec, _) = Type.splitAppTy (Var.varType vec) -- Put the type of the start value in nvec, this will be the type of our -- temporary vector let tmp_ty = Type.mkAppTy nvec (Var.varType start) @@ -248,7 +320,7 @@ genFold'' len left (Left res) f [folded_f, start, vec] = do tmp_vhdl_ty <- MonadState.lift vsType $ vhdl_ty error_msg tmp_ty -- Setup the generate scheme let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec)) - let block_label = mkVHDLExtId ("foldlVector" ++ (varToString start)) + let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res)) let gen_range = if left then AST.ToRange (AST.PrimLit "0") len_min_expr else AST.DownRange len_min_expr (AST.PrimLit "0") let gen_scheme = AST.ForGn n_id gen_range @@ -388,7 +460,7 @@ genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var genConcat' (Left res) f args@[arg] = do { -- Setup the generate scheme ; len1 <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg - ; let (_, nvec) = splitAppTy (Var.varType arg) + ; let (_, nvec) = Type.splitAppTy (Var.varType arg) ; len2 <- MonadState.lift vsType $ tfp_to_int $ tfvec_len_ty nvec -- TODO: Use something better than varToString ; let { label = mkVHDLExtId ("concatVector" ++ (varToString res)) @@ -549,6 +621,17 @@ genApplication dst f args = do let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in mkUncondAssign (Right sel_name) arg Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder" + IdInfo.DataConWrapId dc -> case dst of + -- It's a datacon. Create a record from its arguments. + Left bndr -> do + case (Map.lookup (varToString f) globalNameTable) of + Just (arg_count, builder) -> + if length args == arg_count then + builder dst f args + else + error $ "\nGenerate.genApplication(DataConWrapId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args + Nothing -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper: " ++ (show dc) + Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper application without an original binder" IdInfo.VanillaId -> do -- It's a global value imported from elsewhere. These can be builtin -- functions. Look up the function name in the name table and execute @@ -561,7 +644,7 @@ genApplication dst f args = do builder dst f args else error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args - Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f + Nothing -> error $ ("\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ (pprString f)) IdInfo.ClassOpId cls -> do -- FIXME: Not looking for what instance this class op is called for -- Is quite stupid of course. @@ -609,11 +692,10 @@ genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements genUnconsVectorFuns elemTM vectorTM = [ (exId, (AST.SubProgBody exSpec [] [exExpr],[])) , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet],[])) - , (headId, (AST.SubProgBody headSpec [] [headExpr],[])) , (lastId, (AST.SubProgBody lastSpec [] [lastExpr],[])) , (initId, (AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet],[])) - , (tailId, (AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet],[])) - , (takeId, (AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet],[])) + , (minimumId, (AST.SubProgBody minimumSpec [] [minimumExpr],[])) + , (takeId, (AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet],[minimumId])) , (dropId, (AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet],[])) , (plusgtId, (AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet],[])) , (emptyId, (AST.SubProgBody emptySpec [AST.SPCD emptyVar] [emptyExpr],[])) @@ -636,12 +718,14 @@ genUnconsVectorFuns elemTM vectorTM = vec1Par = AST.unsafeVHDLBasicId "vec1" vec2Par = AST.unsafeVHDLBasicId "vec2" nPar = AST.unsafeVHDLBasicId "n" + leftPar = AST.unsafeVHDLBasicId "nLeft" + rightPar = AST.unsafeVHDLBasicId "nRight" iId = AST.unsafeVHDLBasicId "i" iPar = iId aPar = AST.unsafeVHDLBasicId "a" fPar = AST.unsafeVHDLBasicId "f" sPar = AST.unsafeVHDLBasicId "s" - resId = AST.unsafeVHDLBasicId "res" + resId = AST.unsafeVHDLBasicId "res" exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM, AST.IfaceVarDec ixPar naturalTM] elemTM exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed @@ -658,7 +742,7 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: (AST.PrimLit "1")) ])) Nothing -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1) @@ -667,23 +751,19 @@ genUnconsVectorFuns elemTM vectorTM = AST.PrimName (AST.NSimple aPar) AST.:&: vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1") ((AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing)) + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)) AST.:-: AST.PrimLit "1")) replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) vecSlice init last = AST.PrimName (AST.NSlice (AST.SliceName (AST.NSimple vecPar) (AST.ToRange init last))) - headSpec = AST.Function (mkVHDLExtId headId) [AST.IfaceVarDec vecPar vectorTM] elemTM - -- return vec(0); - headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName - (AST.NSimple vecPar) [AST.PrimLit "0"]))) lastSpec = AST.Function (mkVHDLExtId lastId) [AST.IfaceVarDec vecPar vectorTM] elemTM -- return vec(vec'length-1); lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: AST.PrimLit "1"]))) initSpec = AST.Function (mkVHDLExtId initId) [AST.IfaceVarDec vecPar vectorTM] vectorTM -- variable res : fsvec_x (0 to vec'length-2); @@ -693,49 +773,42 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: (AST.PrimLit "2")) ])) Nothing -- resAST.:= vec(0 to vec'length-2) initExpr = AST.NSimple resId AST.:= (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: AST.PrimLit "2")) initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) - tailSpec = AST.Function (mkVHDLExtId tailId) [AST.IfaceVarDec vecPar vectorTM] vectorTM - -- variable res : fsvec_x (0 to vec'length-2); - tailVar = - AST.VarDec resId - (AST.SubtypeIn vectorTM - (Just $ AST.ConstraintIndex $ AST.IndexConstraint - [AST.ToRange (AST.PrimLit "0") - (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: - (AST.PrimLit "2")) ])) - Nothing - -- res AST.:= vec(1 to vec'length-1) - tailExpr = AST.NSimple resId AST.:= (vecSlice - (AST.PrimLit "1") - (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) - AST.:-: AST.PrimLit "1")) - tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) + minimumSpec = AST.Function (mkVHDLExtId minimumId) [AST.IfaceVarDec leftPar naturalTM, + AST.IfaceVarDec rightPar naturalTM ] naturalTM + minimumExpr = AST.IfSm ((AST.PrimName $ AST.NSimple leftPar) AST.:<: (AST.PrimName $ AST.NSimple rightPar)) + [AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple leftPar)] + [] + (Just $ AST.Else [minimumExprRet]) + where minimumExprRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple rightPar) takeSpec = AST.Function (mkVHDLExtId takeId) [AST.IfaceVarDec nPar naturalTM, AST.IfaceVarDec vecPar vectorTM ] vectorTM - -- variable res : fsvec_x (0 to n-1); + -- variable res : fsvec_x (0 to (minimum (n,vec'length))-1); + minLength = AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId minimumId)) + [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple nPar) + ,Nothing AST.:=>: AST.ADExpr (AST.PrimName (AST.NAttribute $ + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))] takeVar = AST.VarDec resId (AST.SubtypeIn vectorTM (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") - ((AST.PrimName (AST.NSimple nPar)) AST.:-: + (minLength AST.:-: (AST.PrimLit "1")) ])) Nothing -- res AST.:= vec(0 to n-1) takeExpr = AST.NSimple resId AST.:= - (vecSlice (AST.PrimLit "1") - (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1")) + (vecSlice (AST.PrimLit "0") + (minLength AST.:-: AST.PrimLit "1")) takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) dropSpec = AST.Function (mkVHDLExtId dropId) [AST.IfaceVarDec nPar naturalTM, AST.IfaceVarDec vecPar vectorTM ] vectorTM @@ -746,14 +819,14 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ])) Nothing -- res AST.:= vec(n to vec'length-1) dropExpr = AST.NSimple resId AST.:= (vecSlice (AST.PrimName $ AST.NSimple nPar) (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: AST.PrimLit "1")) dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) plusgtSpec = AST.Function (mkVHDLExtId plusgtId) [AST.IfaceVarDec aPar elemTM, @@ -765,7 +838,7 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing))])) + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))])) Nothing plusgtExpr = AST.NSimple resId AST.:= ((AST.PrimName $ AST.NSimple aPar) AST.:&: @@ -819,7 +892,7 @@ genUnconsVectorFuns elemTM vectorTM = -- for i res'range loop -- res(i) := vec(f+i*s); -- end loop; - selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) rangeId Nothing) [selAssign] + selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [selAssign] -- res(i) := vec(f+i*s); selAssign = let origExp = AST.PrimName (AST.NSimple fPar) AST.:+: (AST.PrimName (AST.NSimple iId) AST.:*: @@ -837,7 +910,7 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing))])) + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))])) Nothing ltplusExpr = AST.NSimple resId AST.:= ((AST.PrimName $ AST.NSimple vecPar) AST.:&: @@ -853,9 +926,9 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vec1Par) (mkVHDLBasicId lengthId) Nothing) AST.:+: + AST.AttribName (AST.NSimple vec1Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:+: AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vec2Par) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vec2Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: AST.PrimLit "1")])) Nothing plusplusExpr = AST.NSimple resId AST.:= @@ -864,7 +937,7 @@ genUnconsVectorFuns elemTM vectorTM = plusplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing)) + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)) shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM, AST.IfaceVarDec aPar elemTM ] vectorTM -- variable res : fsvec_x (0 to vec'length-1); @@ -874,7 +947,7 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: (AST.PrimLit "1")) ])) Nothing -- res := a & init(vec) @@ -892,7 +965,7 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: (AST.PrimLit "1")) ])) Nothing -- res := tail(vec) & a @@ -906,7 +979,7 @@ genUnconsVectorFuns elemTM vectorTM = -- return vec'length = 0 nullExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:=: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:=: AST.PrimLit "0") rotlSpec = AST.Function (mkVHDLExtId rotlId) [AST.IfaceVarDec vecPar vectorTM] vectorTM -- variable res : fsvec_x (0 to vec'length-1); @@ -916,7 +989,7 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: (AST.PrimLit "1")) ])) Nothing -- if null(vec) then res := vec else res := last(vec) & init(vec) @@ -940,7 +1013,7 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: (AST.PrimLit "1")) ])) Nothing -- if null(vec) then res := vec else res := tail(vec) & head(vec) @@ -963,24 +1036,25 @@ genUnconsVectorFuns elemTM vectorTM = (Just $ AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimName (AST.NAttribute $ - AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-: + AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: (AST.PrimLit "1")) ])) Nothing -- for i in 0 to res'range loop -- res(vec'length-i-1) := vec(i); -- end loop; reverseFor = - AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) rangeId Nothing) [reverseAssign] + AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [reverseAssign] -- res(vec'length-i-1) := vec(i); reverseAssign = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [destExp]) AST.:= (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $ AST.NSimple iId])) where destExp = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple vecPar) - (mkVHDLBasicId lengthId) Nothing) AST.:-: + (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-: AST.PrimName (AST.NSimple iId) AST.:-: (AST.PrimLit "1") -- return res; reverseRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId)) + ----------------------------------------------------------------------------- -- A table of builtin functions @@ -990,7 +1064,7 @@ genUnconsVectorFuns elemTM vectorTM = -- builder function. globalNameTable :: NameTable globalNameTable = Map.fromList - [ (exId , (2, genFCall False ) ) + [ (exId , (2, genFCall True ) ) , (replaceId , (3, genFCall False ) ) , (headId , (1, genFCall True ) ) , (lastId , (1, genFCall True ) ) @@ -1035,4 +1109,7 @@ globalNameTable = Map.fromList , (fromSizedWordId , (1, genFromSizedWord ) ) , (fromIntegerId , (1, genFromInteger ) ) , (resizeId , (1, genResize ) ) + , (sizedIntId , (1, genSizedInt ) ) + , (tfvecId , (1, genTFVec ) ) + , (minimumId , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name")) ]