X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;ds=sidebyside;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=3d31529a86cc3c7b46b0930a4dc0aa748283c2cf;hb=e1ef152dc63f28dddce2de4950ec739c79c8d18f;hp=0c1f2d7ec709373589d2cd69ed899ef439cf6c56;hpb=8663a3e3f2776039a31528c3087ef5725d401932;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 0c1f2d7..3d31529 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@ -278,19 +278,11 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
       
     _ -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
 
--- Multiple case alt are be conditional assignments and have only wild
+-- Multiple case alt become conditional assignments and have only wild
 -- 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
---   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"
+mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) _ _ (alt:alts))) = do
   scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
   -- Omit first condition, which is the default
   altcons <- MonadState.lift tsType $ mapM (altconToVHDLExpr . (\(con,_,_) -> con)) alts
@@ -391,7 +383,7 @@ genNegation' _ f [arg] = do
   let (tycon, args) = Type.splitTyConApp ty
   let name = Name.getOccString (TyCon.tyConName tycon)
   case name of
-    "SizedInt" -> return $ AST.Neg arg1
+    "Signed" -> return $ AST.Neg arg1
     otherwise -> error $ "\nGenerate.genNegation': Negation not allowed for type: " ++ show name 
 
 -- | Generate a function call from the destination binder, function name and a
@@ -440,8 +432,8 @@ genResize' (Left res) f [arg] = do {
         ; name = Name.getOccString (TyCon.tyConName tycon)
         } ;
   ; len <- case name of
-      "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
-      "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
+      "Signed" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
+      "Unsigned" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
   ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
              [Nothing AST.:=>: AST.ADExpr arg, Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
   }
@@ -456,9 +448,9 @@ genTimes' (Left res) f [arg1,arg2] = do {
         ; name = Name.getOccString (TyCon.tyConName tycon)
         } ;
   ; len <- case name of
-      "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
-      "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
-      "RangedWord" -> do {  ubound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
+      "Signed" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
+      "Unsigned" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
+      "Index" -> do {  ubound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
                          ;  let bitsize = floor (logBase 2 (fromInteger (toInteger ubound)))
                          ;  return bitsize
                          }
@@ -478,12 +470,12 @@ genFromInteger' (Left res) f args = do
   let (tycon, tyargs) = Type.splitTyConApp ty
   let name = Name.getOccString (TyCon.tyConName tycon)
   len <- case name of
-    "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
-    "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
-    "RangedWord" -> do
+    "Signed" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
+    "Unsigned" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
+    "Index" -> do
       bound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
       return $ floor (logBase 2 (fromInteger (toInteger (bound)))) + 1
-  let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId ; "RangedWord" -> toUnsignedId
+  let fname = case name of "Signed" -> toSignedId ; "Unsigned" -> toUnsignedId ; "Index" -> toUnsignedId
   case args of
     [integer] -> do -- The type and dictionary arguments are removed by genApplication
       literal <- getIntegerLiteral integer
@@ -497,6 +489,10 @@ genSizedInt :: BuiltinBuilder
 genSizedInt = genFromInteger
 
 {-
+-- This function is useful for use with vectorTH, since that generates
+-- explicit references to the TFVec constructor (which is normally
+-- hidden). Below implementation is probably not current anymore, but
+-- kept here in case we start using vectorTH again.
 -- | Generate a Builder for the builtin datacon TFVec
 genTFVec :: BuiltinBuilder
 genTFVec (Left res) f [Left (CoreSyn.Let (CoreSyn.Rec letBinders) letRes)] = do {