From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Fri, 14 Aug 2009 11:30:08 +0000 (+0200)
Subject: Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=cf53d927025a818188af17622903df33ade92ff8;hp=-c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Merge branch 'cλash' of git.stderr.nl/matthijs/projects/master-project

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Be more strict in state recognition.
---

cf53d927025a818188af17622903df33ade92ff8
diff --combined "c\316\273ash/CLasH/VHDL/Generate.hs"
index ba84747,1547458..48b5616
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@@ -50,9 -50,7 +50,9 @@@ getEntity fname = Utils.makeCached fnam
        args' <- catMaybesM $ mapM mkMap args
        -- TODO: Handle Nothing
        res' <- mkMap res
 -      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname
 +      count <- getA tsEntityCounter 
 +      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
 +      putA tsEntityCounter (count + 1)
        let ent_decl = createEntityAST vhdl_id args' res'
        let signature = Entity vhdl_id args' res' ent_decl
        return signature
@@@ -144,12 -142,12 +144,12 @@@ getArchitecture fname = Utils.makeCache
                -> TranslatorSession ((Maybe CoreSyn.CoreBndr, Maybe CoreSyn.CoreBndr), ([AST.ConcSm], [CoreSyn.CoreBndr]))
                -- ^ ((Input state variable, output state variable), (statements, used entities))
      -- newtype unpacking is just a cast
-     dobind (bndr, (CoreSyn.Cast expr coercion)) 
-       | hasStateType expr
+     dobind (bndr, unpacked@(CoreSyn.Cast packed coercion)) 
+       | hasStateType packed && not (hasStateType unpacked)
        = return ((Just bndr, Nothing), ([], []))
      -- With simplCore, newtype packing is just a cast
-     dobind (bndr, expr@(CoreSyn.Cast (CoreSyn.Var state) coercion)) 
-       | hasStateType expr
+     dobind (bndr, packed@(CoreSyn.Cast unpacked@(CoreSyn.Var state) coercion)) 
+       | hasStateType packed && not (hasStateType unpacked)
        = return ((Nothing, Just state), ([], []))
      -- Without simplCore, newtype packing uses a data constructor
      dobind (bndr, (CoreSyn.App (CoreSyn.App (CoreSyn.Var con) (CoreSyn.Type _)) (CoreSyn.Var state))) 
@@@ -648,34 -646,6 +648,34 @@@ genZip' (Left res) f args@[arg1, arg2] 
      -- 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
@@@ -863,7 -833,7 +863,7 @@@ genApplication dst f args = d
            let entity_id = ent_id signature
            -- TODO: Using show here isn't really pretty, but we'll need some
            -- unique-ish value...
 -          let label = "comp_ins_" ++ (either show prettyShow) dst
 +          let label = "comp_ins_" ++ (either (prettyShow . varToVHDLName) prettyShow) dst
            let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
            return ([mkComponentInst label entity_id portmaps], [f])
          False -> do
@@@ -1407,10 -1377,6 +1407,10 @@@ globalNameTable = Map.fromLis
    , (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             ) )
@@@ -1420,8 -1386,6 +1420,8 @@@
    , (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"))
    ]