X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FVHDL%2FGenerate.hs;h=191ae9cf5a6e9242b54d6bbcec17047ac3c3bbfb;hb=e82d5210946093b03d9c46b7ffbcb556304e5b0b;hp=b0417da0c3fd828ed1b4fc8116ef1c6847979e3c;hpb=bea4694b9b693a7562c39ed09a28dfefc9f8ce82;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/clash/CLasH/VHDL/Generate.hs b/clash/CLasH/VHDL/Generate.hs index b0417da..191ae9c 100644 --- a/clash/CLasH/VHDL/Generate.hs +++ b/clash/CLasH/VHDL/Generate.hs @@ -291,12 +291,12 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) _ _ alts)) = do (enums, cmp) <- case htype of EnumType _ enums -> do -- Enumeration type, compare with the scrutinee directly - return (map stringToVHDLExpr enums, scrut_expr) + return (map (AST.PrimLit . show) [0..(length enums)-1], scrut_expr) AggrType _ (Just (name, EnumType _ enums)) _ -> do -- Extract the enumeration field from the aggregation let sel_name = mkSelectedName (varToVHDLName scrut) (mkVHDLBasicId name) let sel_expr = AST.PrimName sel_name - return (map stringToVHDLExpr enums, sel_expr) + return (map (AST.PrimLit . show) [0..(length enums)-1], sel_expr) (BuiltinType "Bit") -> do let enums = [AST.PrimLit "'1'", AST.PrimLit "'0'"] return (enums, scrut_expr) @@ -596,7 +596,7 @@ genMap (Left res) f [(Left mapped_f, _), (Left (CoreSyn.Var arg), _)] = do { ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res ; let res_type = (tfvec_elem . Var.varType) res -- TODO: Use something better than varToString - ; let { label = mkVHDLExtId ("mapVector" ++ (varToString res)) + ; let { label = mkVHDLExtId ("mapVector" ++ (varToUniqString res)) ; n_id = mkVHDLBasicId "n" ; n_expr = idToVHDLExpr n_id ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1)) @@ -621,7 +621,7 @@ genZipWith (Left res) f args@[(Left zipped_f, _), (Left (CoreSyn.Var arg1), _), ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res ; let res_type = (tfvec_elem . Var.varType) res -- TODO: Use something better than varToString - ; let { label = mkVHDLExtId ("zipWithVector" ++ (varToString res)) + ; let { label = mkVHDLExtId ("zipWithVector" ++ (varToUniqString res)) ; n_id = mkVHDLBasicId "n" ; n_expr = idToVHDLExpr n_id ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1)) @@ -672,7 +672,7 @@ genFold' len left (Left res) f [(Left folded_f,_), (start,startType), (vec,vecTy Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdlTy error_msg tmp_ty -- Setup the generate scheme let gen_label = mkVHDLExtId ("foldlVector" ++ (show vecExpr)) - let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res)) + let block_label = mkVHDLExtId ("foldlVector" ++ (varToUniqString 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 @@ -714,11 +714,13 @@ genFold' len left (Left res) f [(Left folded_f,_), (start,startType), (vec,vecTy -- argexpr1 <- MonadState.lift tsType $ varToVHDLExpr start -- Input from vec[current n] let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName vecName n_cur - (app_concsms, used) <- genApplication (Right resname,res_type) (exprToVar folded_f) ( if left then + let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs folded_f + let valargs = get_val_args (Var.varType real_f) already_mapped_args + (app_concsms, used) <- genApplication (Right resname,res_type) real_f ((zip (map Left valargs) (map CoreUtils.exprType valargs)) ++ ( if left then [(Right argexpr1, startType), (Right argexpr2, tfvec_elem vecType)] else [(Right argexpr2, tfvec_elem vecType), (Right argexpr1, startType)] - ) + )) -- Return the conditional generate part return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used) @@ -736,11 +738,13 @@ genFold' len left (Left res) f [(Left folded_f,_), (start,startType), (vec,vecTy let argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev -- Input from vec[current n] let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName vecName n_cur - (app_concsms, used) <- genApplication (Right resname,res_type) (exprToVar folded_f) ( if left then + let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs folded_f + let valargs = get_val_args (Var.varType real_f) already_mapped_args + (app_concsms, used) <- genApplication (Right resname,res_type) real_f ((zip (map Left valargs) (map CoreUtils.exprType valargs)) ++ ( if left then [(Right argexpr1, startType), (Right argexpr2, tfvec_elem vecType)] else [(Right argexpr2, tfvec_elem vecType), (Right argexpr1, startType)] - ) + )) -- Return the conditional generate part return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used) @@ -754,7 +758,7 @@ genZip' (Left res) f args@[(arg1,_), (arg2,_)] = do { ; res_htype <- MonadState.lift tsType $ mkHType "\nGenerate.genZip: Invalid result type" (tfvec_elem (Var.varType res)) ; [AST.PrimName argName1, AST.PrimName argName2] <- argsToVHDLExprs [arg1,arg2] -- TODO: Use something better than varToString - ; let { label = mkVHDLExtId ("zipVector" ++ (varToString res)) + ; let { label = mkVHDLExtId ("zipVector" ++ (varToUniqString res)) ; n_id = mkVHDLBasicId "n" ; n_expr = idToVHDLExpr n_id ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1)) @@ -824,7 +828,7 @@ genUnzip' (Left res) f args@[(arg,argType)] = do ; res_htype <- MonadState.lift tsType $ mkHType "\nGenerate.genUnzip: Invalid result type" (Var.varType res) ; [AST.PrimName arg'] <- argsToVHDLExprs [arg] -- TODO: Use something better than varToString - ; let { label = mkVHDLExtId ("unzipVector" ++ (varToString res)) + ; let { label = mkVHDLExtId ("unzipVector" ++ (varToUniqString res)) ; n_id = mkVHDLBasicId "n" ; n_expr = idToVHDLExpr n_id ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1)) @@ -878,7 +882,7 @@ genConcat' (Left res) f args@[(arg,argType)] = do { ; len2 <- MonadState.lift tsType $ tfp_to_int $ tfvec_len_ty nvec ; [AST.PrimName argName] <- argsToVHDLExprs [arg] -- TODO: Use something better than varToString - ; let { label = mkVHDLExtId ("concatVector" ++ (varToString res)) + ; let { label = mkVHDLExtId ("concatVector" ++ (varToUniqString res)) ; n_id = mkVHDLBasicId "n" ; n_expr = idToVHDLExpr n_id ; fromRange = n_expr AST.:*: (AST.PrimLit $ show len2) @@ -935,7 +939,7 @@ genIterateOrGenerate' len iter (Left res) f [(Left app_f,_), (start,startType)] -- Setup the generate scheme [startExpr] <- argsToVHDLExprs [start] let gen_label = mkVHDLExtId ("iterateVector" ++ (show startExpr)) - let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res)) + let block_label = mkVHDLExtId ("iterateVector" ++ (varToUniqString res)) let gen_range = AST.ToRange (AST.PrimLit "0") len_min_expr let gen_scheme = AST.ForGn n_id gen_range -- Make the intermediate vector @@ -969,7 +973,9 @@ genIterateOrGenerate' len iter (Left res) f [(Left app_f,_), (start,startType)] -- Input from start [argexpr] <- argsToVHDLExprs [start] let startassign = mkUncondAssign (Right resname) argexpr - (app_concsms, used) <- genApplication (Right resname, res_type) (exprToVar app_f) [(Right argexpr, startType)] + let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs app_f + let valargs = get_val_args (Var.varType real_f) already_mapped_args + (app_concsms, used) <- genApplication (Right resname, res_type) real_f ((zip (map Left valargs) (map CoreUtils.exprType valargs)) ++ [(Right argexpr, startType)]) -- Return the conditional generate part let gensm = AST.GenerateSm cond_label cond_scheme [] (if iter then [startassign] @@ -987,7 +993,9 @@ genIterateOrGenerate' len iter (Left res) f [(Left app_f,_), (start,startType)] let resname = mkIndexedName tmp_name n_cur -- Input from tmp[previous n] let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev - (app_concsms, used) <- genApplication (Right resname, res_type) (exprToVar app_f) [(Right argexpr, res_type)] + let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs app_f + let valargs = get_val_args (Var.varType real_f) already_mapped_args + (app_concsms, used) <- genApplication (Right resname, res_type) real_f ((zip (map Left valargs) (map CoreUtils.exprType valargs)) ++ [(Right argexpr, res_type)]) -- Return the conditional generate part return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used) @@ -1011,7 +1019,7 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do let rdaddr_int = genExprFCall (mkVHDLBasicId toIntegerId) $ fst rdaddr let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr_int let assign = mkUncondAssign (Right resname) argexpr - let block_label = mkVHDLExtId ("blockRAM" ++ (varToString res)) + let block_label = mkVHDLExtId ("blockRAM" ++ (varToUniqString res)) let block = AST.BlockSm block_label [] (AST.PMapAspect []) [ram_dec] [assign, mkUpdateProcSm] return [AST.CSBSm block] where @@ -1056,6 +1064,21 @@ genSplit' (Left res) f args@[(vecIn,vecInType)] = do { where vecSlice init last = AST.NSlice (AST.SliceName (varToVHDLName res) (AST.ToRange init last)) + +genSll :: BuiltinBuilder +genSll = genNoInsts $ genExprArgs $ genExprRes genSll' +genSll' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [(AST.Expr, Type.Type)] -> TranslatorSession AST.Expr +genSll' res f [(arg1,_),(arg2,_)] = do { + ; return $ (AST.Sll arg1 (genExprFCall (mkVHDLBasicId toIntegerId) arg2)) + } + +genSra :: BuiltinBuilder +genSra = genNoInsts $ genExprArgs $ genExprRes genSra' +genSra' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [(AST.Expr, Type.Type)] -> TranslatorSession AST.Expr +genSra' res f [(arg1,_),(arg2,_)] = do { + ; return $ (AST.Sra arg1 (genExprFCall (mkVHDLBasicId toIntegerId) arg2)) + } + ----------------------------------------------------------------------------- -- Function to generate VHDL for applications ----------------------------------------------------------------------------- @@ -1090,7 +1113,7 @@ genApplication (dst, dsttype) f args = do return ([mkUncondAssign dst arg'], []) -- In all other cases, a record type is created. _ -> case htype_either of - Right htype@(AggrType _ _ _) -> do + Right htype@(AggrType _ etype _) -> do let dc_i = datacon_index dsttype dc let labels = getFieldLabels htype dc_i arg_exprs <- argsToVHDLExprs argsNoState @@ -1102,8 +1125,9 @@ genApplication (dst, dsttype) f args = do -- constructor used to the constructor field as -- well. Just dc_label -> - let dc_expr = AST.PrimName $ AST.NSimple $ mkVHDLExtId $ varToString f in - (dc_label:labels, dc_expr:arg_exprs) + let { dc_index = getConstructorIndex (snd $ Maybe.fromJust etype) (varToString f) + ; dc_expr = AST.PrimLit $ show dc_index + } in (dc_label:labels, dc_expr:arg_exprs) return (zipWith mkassign final_labels final_exprs, []) where mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm @@ -1267,8 +1291,8 @@ genUnconsVectorFuns elemTM vectorTM = , (ltplusId, (AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet],[])) , (plusplusId, (AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet],[])) , (lengthTId, (AST.SubProgBody lengthTSpec [] [lengthTExpr],[])) - , (shiftlId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId])) - , (shiftrId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId])) + , (shiftIntoLId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId])) + , (shiftIntoRId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId])) , (nullId, (AST.SubProgBody nullSpec [] [nullExpr], [])) , (rotlId, (AST.SubProgBody rotlSpec [AST.SPVD rotlVar] [rotlExpr, rotlRet], [nullId, lastId, initId])) , (rotrId, (AST.SubProgBody rotrSpec [AST.SPVD rotrVar] [rotrExpr, rotrRet], [nullId, tailId, headId])) @@ -1496,7 +1520,7 @@ genUnconsVectorFuns elemTM vectorTM = lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)) - shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM, + shiftlSpec = AST.Function (mkVHDLExtId shiftIntoLId) [AST.IfaceVarDec vecPar vectorTM, AST.IfaceVarDec aPar elemTM ] vectorTM -- variable res : fsvec_x (0 to vec'length-1); shiftlVar = @@ -1514,7 +1538,7 @@ genUnconsVectorFuns elemTM vectorTM = (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId)) [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])) shiftlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) - shiftrSpec = AST.Function (mkVHDLExtId shiftrId) [AST.IfaceVarDec vecPar vectorTM, + shiftrSpec = AST.Function (mkVHDLExtId shiftIntoRId) [AST.IfaceVarDec vecPar vectorTM, AST.IfaceVarDec aPar elemTM ] vectorTM -- variable res : fsvec_x (0 to vec'length-1); shiftrVar = @@ -1654,8 +1678,8 @@ globalNameTable = Map.fromList , (foldrId , (3, genFoldr ) ) , (zipId , (2, genZip ) ) , (unzipId , (1, genUnzip ) ) - , (shiftlId , (2, genFCall False ) ) - , (shiftrId , (2, genFCall False ) ) + , (shiftIntoLId , (2, genFCall False ) ) + , (shiftIntoRId , (2, genFCall False ) ) , (rotlId , (1, genFCall False ) ) , (rotrId , (1, genFCall False ) ) , (concatId , (1, genConcat ) ) @@ -1698,6 +1722,9 @@ globalNameTable = Map.fromList , (sndId , (1, genSnd ) ) , (blockRAMId , (5, genBlockRAM ) ) , (splitId , (1, genSplit ) ) + , (xorId , (2, genOperator2 AST.Xor ) ) + , (shiftLId , (2, genSll ) ) + , (shiftRId , (2, genSra ) ) --, (tfvecId , (1, genTFVec ) ) , (minimumId , (2, error "\nFunction name: \"minimum\" is used internally, use another name")) ]