Fix error message genNegation for non-SizedWord types

[matthijs/master-project/cλash.git] / cλash / CLasH / VHDL / Generate.hs

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index dee2a794694394b371f26129a1e79c54ae6c5da2..ea55cc2f42ba51b6341d086b6442ffcecb75925a 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -232,14 +232,23 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
 -- binders in the alts and only variables in the case values and a variable
 -- for a scrutinee. We check the constructor of the second alt, since the
 -- first is the default case, if there is any.
-mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
+
+-- mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
+--   scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
+--   altcon <- MonadState.lift tsType $ altconToVHDLExpr con
+--   let cond_expr = scrut' AST.:=: altcon
+--   true_expr <- MonadState.lift tsType $ varToVHDLExpr true
+--   false_expr <- MonadState.lift tsType $ varToVHDLExpr false
+--   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
-  let cond_expr = scrut' AST.:=: (altconToVHDLExpr con)
-  true_expr <- MonadState.lift tsType $ varToVHDLExpr true
-  false_expr <- MonadState.lift tsType $ varToVHDLExpr false
-  return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], [])
+  -- 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], [])
 
-mkConcSm (_, (CoreSyn.Case (CoreSyn.Var _) _ _ alts)) = error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives"
 mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee"
 mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
 
@@ -336,7 +345,7 @@ genNegation' _ f [arg] = do
   let name = Name.getOccString (TyCon.tyConName tycon)
   case name of
     "SizedInt" -> return $ AST.Neg arg1
-    otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name 
+    otherwise -> error $ "\nGenerate.genNegation': Negation not allowed for type: " ++ show name 
 
 -- | Generate a function call from the destination binder, function name and a
 -- list of expressions (its arguments)
@@ -1006,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
@@ -1014,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
@@ -1460,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                  ) )