X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=70b82a4c391fdf57a3c1a260b44276cb7e457223;hb=60afa8f89d02ac5818d525d6209efe703cc22086;hp=2a931b97ac7363cce35c7e174cac4e3aa1a91294;hpb=819f01a16a903b5bdc234bbbf3b450733a5ef3db;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 2a931b9..70b82a4 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -242,9 +242,9 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt])) -- return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], []) mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) _ _ (alt:alts))) = do --error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives" scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut - -- Rotate conditions to the left, so that the default condition is the last - altcons <- MonadState.lift tsType $ mapM (altconToVHDLExpr . (\(con,_,_) -> con)) (alts ++ [alt]) - let cond_exprs = map (\x -> scrut' AST.:=: x) (init altcons) + -- Omit first condition, which is the default + altcons <- MonadState.lift tsType $ mapM (altconToVHDLExpr . (\(con,_,_) -> con)) alts + let cond_exprs = map (\x -> scrut' 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)) (alts ++ [alt]) return ([mkAltsAssign (Left bndr) cond_exprs exprs], []) @@ -1015,7 +1015,7 @@ vectorFunId el_ty fname = do -- the VHDLState or something. let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM) typefuns <- getA tsTypeFuns - case Map.lookup (OrdType el_ty, fname) typefuns of + case Map.lookup (StdType $ OrdType el_ty, fname) typefuns of -- Function already generated, just return it Just (id, _) -> return id -- Function not generated yet, generate it @@ -1023,7 +1023,7 @@ vectorFunId el_ty fname = do let functions = genUnconsVectorFuns elemTM vectorTM case lookup fname functions of Just body -> do - modA tsTypeFuns $ Map.insert (OrdType el_ty, fname) (function_id, (fst body)) + modA tsTypeFuns $ Map.insert (StdType $ OrdType el_ty, fname) (function_id, (fst body)) mapM_ (vectorFunId el_ty) (snd body) return function_id Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname @@ -1469,7 +1469,8 @@ globalNameTable = Map.fromList , (minusId , (2, genOperator2 (AST.:-:) ) ) , (fromSizedWordId , (1, genFromSizedWord ) ) , (fromIntegerId , (1, genFromInteger ) ) - , (resizeId , (1, genResize ) ) + , (resizeWordId , (1, genResize ) ) + , (resizeIntId , (1, genResize ) ) , (sizedIntId , (1, genSizedInt ) ) , (smallIntegerId , (1, genFromInteger ) ) , (fstId , (1, genFst ) )