X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FVHDL%2FGenerate.hs;h=06bc2655cec986b48e5257a71e99d3a04ab33588;hb=f69e59a92472c3a827ac25b52ab5d70895e19b7e;hp=8c59334085fe6e53bcd153eb514320e96b2a67d0;hpb=30969fa41ee30295f00cf089f4ee4385bb709871;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/clash/CLasH/VHDL/Generate.hs b/clash/CLasH/VHDL/Generate.hs index 8c59334..06bc265 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) @@ -311,7 +311,11 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) _ _ alts)) = do -- alternatives. let cond_exprs = map (\x -> cmp AST.:=: x) altcons -- Rotate expressions to the left, so that the expression related to the default case is the last - exprs <- MonadState.lift tsType $ mapM (varToVHDLExpr . (\(_,_,CoreSyn.Var expr) -> expr)) ((tail alts) ++ [head alts]) + let alts' = case alts of + ((CoreSyn.DEFAULT,_,_):_) -> ((tail alts) ++ [head alts]) + otherwise -> alts + + exprs <- MonadState.lift tsType $ mapM (varToVHDLExpr . (\(_,_,CoreSyn.Var expr) -> expr)) alts' --((tail alts) ++ [head alts]) return ([mkAltsAssign (Left bndr) cond_exprs exprs], []) mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement does not have a simple variable as scrutinee" @@ -596,7 +600,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 +625,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 +676,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 @@ -758,7 +762,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)) @@ -828,7 +832,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)) @@ -882,7 +886,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) @@ -939,7 +943,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 @@ -1019,7 +1023,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 @@ -1113,7 +1117,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 @@ -1125,8 +1129,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