X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=0e147b369c8fd77159908907f1a95f9fb18e23e7;hb=d94fff8d7e24f6518588786141e0ba08d3141ea7;hp=ae4769b3842bbec5850dfe5d7fd875ac94cee797;hpb=12f3011b6d8b84de55288aa15dbaf3ce8f011be4;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 ae4769b..0e147b3 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@ -645,6 +645,34 @@ genZip' (Left res) f args@[arg1, arg2] = do {
     -- Return the generate functions
   ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
   }
+  
+-- | Generate a generate statement for the builtin function "fst"
+genFst :: BuiltinBuilder
+genFst = genNoInsts $ genVarArgs genFst'
+genFst' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
+genFst' (Left res) f args@[arg] = do {
+  ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType arg)
+  ; let { argexpr'    = varToVHDLName arg
+        ; argexprA    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (labels!!0)
+        ; assign      = mkUncondAssign (Left res) argexprA
+        } ;
+    -- Return the generate functions
+  ; return [assign]
+  }
+  
+-- | Generate a generate statement for the builtin function "snd"
+genSnd :: BuiltinBuilder
+genSnd = genNoInsts $ genVarArgs genSnd'
+genSnd' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
+genSnd' (Left res) f args@[arg] = do {
+  ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType arg)
+  ; let { argexpr'    = varToVHDLName arg
+        ; argexprB    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (labels!!1)
+        ; assign      = mkUncondAssign (Left res) argexprB
+        } ;
+    -- Return the generate functions
+  ; return [assign]
+  }
     
 -- | Generate a generate statement for the builtin function "unzip"
 genUnzip :: BuiltinBuilder
@@ -833,7 +861,7 @@ genApplication dst f args = do
           -- TODO: Using show here isn't really pretty, but we'll need some
           -- unique-ish value...
           let label = "comp_ins_" ++ (either show prettyShow) dst
-          portmaps <- mkAssocElems args' ((either varToVHDLName id) dst) signature
+          let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
           return ([mkComponentInst label entity_id portmaps], [f])
         False -> do
           -- Not a top level binder, so this must be a local variable reference.
@@ -842,7 +870,7 @@ genApplication dst f args = do
           -- assignment here.
           f' <- MonadState.lift tsType $ varToVHDLExpr f
           return $ ([mkUncondAssign dst f'], [])
-    True | not stateful -> 
+    True ->
       case Var.idDetails f of
         IdInfo.DataConWorkId dc -> case dst of
           -- It's a datacon. Create a record from its arguments.
@@ -892,7 +920,7 @@ genApplication dst f args = do
                   -- TODO: Using show here isn't really pretty, but we'll need some
                   -- unique-ish value...
                   let label = "comp_ins_" ++ (either show prettyShow) dst
-                  portmaps <- mkAssocElems args' ((either varToVHDLName id) dst) signature
+                  let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
                   return ([mkComponentInst label entity_id portmaps], [f])
                 False -> do
                   -- Not a top level binder, so this must be a local variable reference.
@@ -914,16 +942,6 @@ genApplication dst f args = do
                 error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
             Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
         details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
-    -- If we can't generate a component instantiation, and the destination is
-    -- a state type, don't generate anything.
-    _ -> return ([], [])
-  where
-    -- Is our destination a state value?
-    stateful = case dst of
-      -- When our destination is a VHDL name, it won't have had a state type
-      Right _ -> False
-      -- Otherwise check its type
-      Left bndr -> hasStateType bndr
 
 -----------------------------------------------------------------------------
 -- Functions to generate functions dealing with vectors.
@@ -1386,6 +1404,10 @@ globalNameTable = Map.fromList
   , (hwandId          , (2, genOperator2 AST.And    ) )
   , (hworId           , (2, genOperator2 AST.Or     ) )
   , (hwnotId          , (1, genOperator1 AST.Not    ) )
+  , (equalityId       , (2, genOperator2 (AST.:=:)  ) )
+  , (inEqualityId     , (2, genOperator2 (AST.:/=:) ) )
+  , (boolOrId         , (2, genOperator2 AST.Or     ) )
+  , (boolAndId        , (2, genOperator2 AST.And    ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
   , (timesId          , (2, genOperator2 (AST.:*:)  ) )
   , (negateId         , (1, genNegation             ) )
@@ -1395,6 +1417,8 @@ globalNameTable = Map.fromList
   , (resizeId         , (1, genResize               ) )
   , (sizedIntId       , (1, genSizedInt             ) )
   , (smallIntegerId   , (1, genFromInteger          ) )
+  , (fstId            , (1, genFst                  ) )
+  , (sndId            , (1, genSnd                  ) )
   --, (tfvecId          , (1, genTFVec                ) )
   , (minimumId        , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))
   ]