Fix bug with generating head and tail functions. Update builtin resize function

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

diff --git a/cλash/CLasH/VHDL/VHDLTools.hs b/cλash/CLasH/VHDL/VHDLTools.hs
index 5fc34739611f4fa9efd4825e8fb32d65164dfd31..edca0c306325bea654e9eaa86b71ba9afdeea112 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/CLasH/VHDL/VHDLTools.hs
@@ -73,7 +73,7 @@ mkAssign dst cond false_expr =
     whenelse = case cond of
       Just (cond_expr, true_expr) -> 
         let 
-          true_wform = AST.Wform [AST.WformElem true_expr Nothing] 
+          true_wform = AST.Wform [AST.WformElem true_expr Nothing]
         in
           [AST.WhenElse true_wform cond_expr]
       Nothing -> []
@@ -85,6 +85,31 @@ mkAssign dst cond false_expr =
   in
     AST.CSSASm assign
 
+mkAltsAssign ::
+  Either CoreBndr AST.VHDLName            -- ^ The signal to assign to
+  -> [AST.Expr]       -- ^ The conditions
+  -> [AST.Expr]       -- ^ The expressions
+  -> AST.ConcSm   -- ^ The Alt assigns
+mkAltsAssign dst conds exprs
+        | (length conds) /= ((length exprs) - 1) = error $ "\nVHDLTools.mkAltsAssign: conditions expression mismatch"
+        | otherwise =
+  let
+    whenelses   = zipWith mkWhenElse conds exprs
+    false_wform = AST.Wform [AST.WformElem (last exprs) Nothing]
+    dst_name  = case dst of
+      Left bndr -> AST.NSimple (varToVHDLId bndr)
+      Right name -> name
+    assign    = dst_name AST.:<==: (AST.ConWforms whenelses false_wform Nothing)
+  in
+    AST.CSSASm assign
+  where
+    mkWhenElse :: AST.Expr -> AST.Expr -> AST.WhenElse
+    mkWhenElse cond true_expr =
+      let
+        true_wform = AST.Wform [AST.WformElem true_expr Nothing]
+      in
+        AST.WhenElse true_wform cond
+
 mkAssocElems :: 
   [AST.Expr]                    -- ^ The argument that are applied to function
   -> AST.VHDLName               -- ^ The binder in which to store the result
@@ -388,7 +413,8 @@ mk_tycon_ty ty tycon args =
               let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names
               let ty_def = AST.TDR $ AST.RecordTypeDef elems
               let tupshow = mkTupleShow elem_tys ty_id
-              modA tsTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, tupshow)
+              let htype = ADTType (nameToString (TyCon.tyConName tycon)) (map (\x -> StdType (OrdType x)) real_arg_tys)
+              modA tsTypeFuns $ Map.insert (htype, showIdString) (showId, tupshow)
               return $ Right $ Just (ty_id, Left ty_def)
         -- There were errors in element types
         (errors, _) -> return $ Left $
@@ -403,7 +429,8 @@ mk_tycon_ty ty tycon args =
           let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon)
           let ty_def = AST.TDE $ AST.EnumTypeDef elems
           let enumShow = mkEnumShow elems ty_id
-          modA tsTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, enumShow)
+          let htype = EnumType (nameToString (TyCon.tyConName tycon)) (map (nameToString . DataCon.dataConName) dcs)
+          modA tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow)
           return $ Right $ Just (ty_id, Left ty_def)
         xs -> return $ Left $
           "VHDLTools.mkTyConHType: Only enum-like constructor datatypes supported: " ++ pprString dcs ++ "\n"
@@ -447,7 +474,7 @@ mk_vector_ty ty = do
           modA tsTypes (Map.insert (StdType $ OrdType vec_ty) (Just (vec_id, (Left vec_def))))
           modA tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
           let vecShowFuns = mkVectorShow el_ty_tm vec_id
-          mapM_ (\(id, subprog) -> modA tsTypeFuns $ Map.insert (OrdType vec_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
+          mapM_ (\(id, subprog) -> modA tsTypeFuns $ Map.insert (StdType $ OrdType el_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
           let ty_def = AST.SubtypeIn vec_id (Just range)
           return (Right $ Just (ty_id, Right ty_def))
     -- Empty element type? Empty vector type then. TODO: Does this make sense?