X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=0e147b369c8fd77159908907f1a95f9fb18e23e7;hb=d94fff8d7e24f6518588786141e0ba08d3141ea7;hp=0e5186fca0ef87587c41430be032c4f41d4d4211;hpb=78cf1d7edd55f14548761a01352361e25995f7db;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 0e5186f..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.
@@ -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.
@@ -1376,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             ) )
@@ -1385,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"))
   ]