Merge branch 'master' of git://github.com/christiaanb/clash into cλash
authorMatthijs Kooijman <m.kooijman@student.utwente.nl>
Fri, 14 Aug 2009 12:02:50 +0000 (14:02 +0200)
committerMatthijs Kooijman <m.kooijman@student.utwente.nl>
Fri, 14 Aug 2009 12:02:50 +0000 (14:02 +0200)
* 'master' of git://github.com/christiaanb/clash:
  Hopefully generate completely unique varNames now (also for comp_ins labels)
  Generate more unique variable names, generate truely unique entity names
  Add boolean or and and, tuple fst and snd function.
  Added equals builtin. And fixed show function generation for integers
  Class Num is re-exported by CLasH.HardwareTypes, so no need to use the one in Prelude

1  2 
cλash/CLasH/VHDL/Generate.hs

index 154745879524de3880d3797c965be280c81f07eb,ba84747854c05bd14582cd7d71f1b8e84d0008ee..48b56169241214dccd82cf574bddf28929fcc86a
@@@ -50,7 -50,9 +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
@@@ -142,12 -144,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))) 
@@@ -646,6 -648,34 +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
@@@ -833,7 -863,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
@@@ -1377,6 -1407,10 +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             ) )
    , (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"))
    ]