From: Matthijs Kooijman Date: Tue, 23 Jun 2009 13:17:12 +0000 (+0200) Subject: Merge git://github.com/darchon/clash into cλash X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=5ffa570103939a4e732d2a2c6ec99d77674b34e8;hp=528eea4600faddffb577c6582a46c9732ab2679d;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Merge git://github.com/darchon/clash into cλash * git://github.com/darchon/clash: Added singleton Almost finished support for 'map' Conflicts: VHDL.hs --- diff --git a/Adders.hs b/Adders.hs index c438914..3afb82f 100644 --- a/Adders.hs +++ b/Adders.hs @@ -175,6 +175,11 @@ highordtest = \x -> functiontest :: TFVec D4 Bit -> TFVec D5 Bit -> RangedWord D3 -> RangedWord D4 -> (Bit, Bit) functiontest = \v1 v2 i1 i2 -> let r1 = v1!i1 ; r2 = v2!i2 in (r1,r2) +xhwnot x = hwnot x + +maptest :: TFVec D4 Bit -> TFVec D4 Bit +maptest = \v -> let r = map xhwnot v in r + highordtest2 = \a b -> case a of High -> \c d -> d diff --git a/Generate.hs b/Generate.hs index 6405a6e..637ef27 100644 --- a/Generate.hs +++ b/Generate.hs @@ -27,12 +27,11 @@ genExprFCall fName args = genMapCall :: Int -- | The length of the vector -> Entity -- | The entity to map - -> AST.VHDLId -- | The input vector - -> AST.VHDLId -- | The output vector + -> [AST.VHDLId] -- | The vectors -> AST.GenerateSm -- | The resulting generate statement -genMapCall len entity arg res = genSm +genMapCall len entity [arg, res] = genSm where - label = AST.unsafeVHDLBasicId "mapVector" + label = AST.unsafeVHDLBasicId ("mapVector" ++ (AST.fromVHDLId res)) nPar = AST.unsafeVHDLBasicId "n" range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1)) genScheme = AST.ForGn nPar range @@ -63,7 +62,8 @@ genUnconsVectorFuns elemTM vectorTM = , AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet] , AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet] , AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet] - , AST.SubProgBody emptySpec [AST.SPVD emptyVar] [emptyExpr] + , AST.SubProgBody emptySpec [AST.SPVD emptyVar] [emptyExpr] + , AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet] ] where ixPar = AST.unsafeVHDLBasicId "ix" @@ -210,4 +210,15 @@ genUnconsVectorFuns elemTM vectorTM = [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "-1")])) Nothing - emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId)) \ No newline at end of file + emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId)) + singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ] + vectorTM + -- variable res : fsvec_x (0 to 0) := (others => a); + singletonVar = + AST.VarDec resId + (AST.SubtypeIn vectorTM + (Just $ AST.ConstraintIndex $ AST.IndexConstraint + [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")])) + (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others) + (AST.PrimName $ AST.NSimple aPar)]) + singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) \ No newline at end of file diff --git a/GlobalNameTable.hs b/GlobalNameTable.hs index 49b717c..429b966 100644 --- a/GlobalNameTable.hs +++ b/GlobalNameTable.hs @@ -12,23 +12,25 @@ import VHDLTypes import Constants import Generate -mkGlobalNameTable :: [(String, (Int, [AST.Expr] -> AST.Expr ) )] -> NameTable +mkGlobalNameTable :: [(String, (Int, Builder) )] -> NameTable mkGlobalNameTable = Map.fromList globalNameTable :: NameTable globalNameTable = mkGlobalNameTable - [ ("!" , (2, genExprFCall exId ) ) - , ("replace" , (3, genExprFCall replaceId ) ) - , ("head" , (1, genExprFCall headId ) ) - , ("last" , (1, genExprFCall lastId ) ) - , ("tail" , (1, genExprFCall tailId ) ) - , ("init" , (1, genExprFCall initId ) ) - , ("take" , (2, genExprFCall takeId ) ) - , ("drop" , (2, genExprFCall dropId ) ) - , ("+>" , (2, genExprFCall plusgtId ) ) - , ("empty" , (0, genExprFCall emptyId ) ) - , ("hwxor" , (2, genExprOp2 AST.Xor ) ) - , ("hwand" , (2, genExprOp2 AST.And ) ) - , ("hwor" , (2, genExprOp2 AST.Or ) ) - , ("hwnot" , (1, genExprOp1 AST.Not ) ) + [ ("!" , (2, Left $ genExprFCall exId ) ) + , ("replace" , (3, Left $ genExprFCall replaceId ) ) + , ("head" , (1, Left $ genExprFCall headId ) ) + , ("last" , (1, Left $ genExprFCall lastId ) ) + , ("tail" , (1, Left $ genExprFCall tailId ) ) + , ("init" , (1, Left $ genExprFCall initId ) ) + , ("take" , (2, Left $ genExprFCall takeId ) ) + , ("drop" , (2, Left $ genExprFCall dropId ) ) + , ("+>" , (2, Left $ genExprFCall plusgtId ) ) + , ("map" , (2, Right $ genMapCall ) ) + , ("empty" , (0, Left $ genExprFCall emptyId ) ) + , ("singleton" , (1, Left $ genExprFCall singletonId ) ) + , ("hwxor" , (2, Left $ genExprOp2 AST.Xor ) ) + , ("hwand" , (2, Left $ genExprOp2 AST.And ) ) + , ("hwor" , (2, Left $ genExprOp2 AST.Or ) ) + , ("hwnot" , (1, Left $ genExprOp1 AST.Not ) ) ] diff --git a/VHDL.hs b/VHDL.hs index 15eb4c5..6a89930 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -294,17 +294,30 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do -- It's a global value imported from elsewhere. These can be builtin -- functions. funSignatures <- getA vsNameTable + signatures <- getA vsSignatures case (Map.lookup (bndrToString f) funSignatures) of Just (arg_count, builder) -> if length valargs == arg_count then - let - sigs = map (varToVHDLExpr.varBndr) valargs - func = builder sigs - src_wform = AST.Wform [AST.WformElem func Nothing] - dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr)) - assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing) - in - return [AST.CSSASm assign] + case builder of + Left funBuilder -> + let + sigs = map (varToVHDLExpr.varBndr) valargs + func = funBuilder sigs + src_wform = AST.Wform [AST.WformElem func Nothing] + dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr)) + assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing) + in + return [AST.CSSASm assign] + Right genBuilder -> + let + sigs = map varBndr valargs + signature = Maybe.fromMaybe + (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!") + (Map.lookup (head sigs) signatures) + arg_names = map (mkVHDLExtId . bndrToString) (tail sigs) + dst_name = mkVHDLExtId (bndrToString bndr) + genSm = genBuilder 4 signature (arg_names ++ [dst_name]) + in return [AST.CSGSm genSm] else error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f diff --git a/VHDLTypes.hs b/VHDLTypes.hs index 6f6625b..2538158 100644 --- a/VHDLTypes.hs +++ b/VHDLTypes.hs @@ -54,8 +54,10 @@ type TypeFunMap = Map.Map OrdType [AST.SubProgBody] -- A map of a Haskell function to a hardware signature type SignatureMap = Map.Map CoreSyn.CoreBndr Entity +type Builder = Either ([AST.Expr] -> AST.Expr) (Int -> Entity -> [AST.VHDLId] -> AST.GenerateSm) + -- A map of a builtin function to VHDL function builder -type NameTable = Map.Map String (Int, [AST.Expr] -> AST.Expr ) +type NameTable = Map.Map String (Int, Builder ) data VHDLSession = VHDLSession { -- | A map of Core type -> VHDL Type