From: Christiaan Baaij Date: Tue, 23 Jun 2009 12:27:08 +0000 (+0200) Subject: Almost finished support for 'map' X-Git-Url: https://git.stderr.nl/gitweb?p=matthijs%2Fmaster-project%2Fc%CE%BBash.git;a=commitdiff_plain;h=acdf6e104979ff6354caeecf73eef680ea9369e4 Almost finished support for 'map' Currently it only supports vectors of lenght 4 --- 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..f81d769 100644 --- a/Generate.hs +++ b/Generate.hs @@ -27,10 +27,9 @@ 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" nPar = AST.unsafeVHDLBasicId "n" diff --git a/GlobalNameTable.hs b/GlobalNameTable.hs index 49b717c..8d38f6c 100644 --- a/GlobalNameTable.hs +++ b/GlobalNameTable.hs @@ -12,23 +12,24 @@ 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 ) ) + , ("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 eb45420..a40ad00 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -289,18 +289,31 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do -- It's a global value imported from elsewhere. These can be builtin -- functions. funSignatures <- getA vsNameTable + entSignatures <- getA vsSignatures case (Map.lookup (bndrToString f) funSignatures) of Just (arg_count, builder) -> if length valargs == arg_count then - let - sigs = map (bndrToString.varBndr) valargs - sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs - func = builder sigsNames - 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 (bndrToString.varBndr) valargs + sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs + func = funBuilder sigsNames + 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) entSignatures) + arg_name = mkVHDLExtId (bndrToString (last sigs)) + dst_name = mkVHDLExtId (bndrToString bndr) + genSm = genBuilder 4 signature [arg_name, 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