X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Generate.hs;h=97b8bef7ff8c92ebb3738aeaafd64f035e1f20af;hb=8782caddd5cc4df0c68e4025266c9b558e32eb48;hp=6b19bb5d729806ee0eb18e8f3a9faaa2e269ee93;hpb=afd269e5653952394495a7a14ad1bfc0c0146b39;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Generate.hs b/Generate.hs index 6b19bb5..97b8bef 100644 --- a/Generate.hs +++ b/Generate.hs @@ -72,16 +72,26 @@ genOperator1' op _ f [arg] = return $ op arg -- | Generate a function call from the destination binder, function name and a -- list of expressions (its arguments) -genFCall :: BuiltinBuilder -genFCall = genExprArgs $ genExprRes genFCall' -genFCall' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr -genFCall' (Left res) f args = do +genFCall :: Bool -> BuiltinBuilder +genFCall switch = genExprArgs $ genExprRes (genFCall' switch) +genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr +genFCall' switch (Left res) f args = do let fname = varToString f - let el_ty = (tfvec_elem . Var.varType) res + let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res) id <- MonadState.lift vsType $ vectorFunId el_ty fname return $ AST.PrimFCall $ AST.FCall (AST.NSimple id) $ map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args -genFCall' (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name +genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name + +genFromSizedWord :: BuiltinBuilder +genFromSizedWord = genExprArgs $ genExprRes genFromSizedWord' +genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr +genFromSizedWord' (Left res) f args = do + let fname = varToString f + return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $ + map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args +genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name + -- | Generate a generate statement for the builtin function "map" genMap :: BuiltinBuilder @@ -440,8 +450,8 @@ genApplication dst f args = if length args == arg_count then builder dst f args else - error $ "\nGenerate.genApplication: Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args - Nothing -> error $ "\nGenerate.genApplication: Using function from another module that is not a known builtin: " ++ pprString f + error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args + Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f IdInfo.NotGlobalId -> do signatures <- getA vsSignatures -- This is a local id, so it should be a function whose definition we @@ -457,6 +467,16 @@ genApplication dst f args = portmaps = mkAssocElems (map (either exprToVHDLExpr id) args) ((either varToVHDLName id) dst) signature in return [mkComponentInst label entity_id portmaps] + IdInfo.ClassOpId cls -> do + -- FIXME: Not looking for what instance this class op is called for + -- Is quite stupid of course. + case (Map.lookup (varToString f) globalNameTable) of + Just (arg_count, builder) -> + if length args == arg_count then + builder dst f args + else + error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args + Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details ----------------------------------------------------------------------------- @@ -875,42 +895,47 @@ genUnconsVectorFuns elemTM vectorTM = -- builder function. globalNameTable :: NameTable globalNameTable = Map.fromList - [ (exId , (2, genFCall ) ) - , (replaceId , (3, genFCall ) ) - , (headId , (1, genFCall ) ) - , (lastId , (1, genFCall ) ) - , (tailId , (1, genFCall ) ) - , (initId , (1, genFCall ) ) - , (takeId , (2, genFCall ) ) - , (dropId , (2, genFCall ) ) - , (selId , (4, genFCall ) ) - , (plusgtId , (2, genFCall ) ) - , (ltplusId , (2, genFCall ) ) - , (plusplusId , (2, genFCall ) ) + [ (exId , (2, genFCall False ) ) + , (replaceId , (3, genFCall False ) ) + , (headId , (1, genFCall True ) ) + , (lastId , (1, genFCall True ) ) + , (tailId , (1, genFCall False ) ) + , (initId , (1, genFCall False ) ) + , (takeId , (2, genFCall False ) ) + , (dropId , (2, genFCall False ) ) + , (selId , (4, genFCall False ) ) + , (plusgtId , (2, genFCall False ) ) + , (ltplusId , (2, genFCall False ) ) + , (plusplusId , (2, genFCall False ) ) , (mapId , (2, genMap ) ) , (zipWithId , (3, genZipWith ) ) , (foldlId , (3, genFoldl ) ) , (foldrId , (3, genFoldr ) ) , (zipId , (2, genZip ) ) , (unzipId , (1, genUnzip ) ) - , (shiftlId , (2, genFCall ) ) - , (shiftrId , (2, genFCall ) ) - , (rotlId , (1, genFCall ) ) - , (rotrId , (1, genFCall ) ) + , (shiftlId , (2, genFCall False ) ) + , (shiftrId , (2, genFCall False ) ) + , (rotlId , (1, genFCall False ) ) + , (rotrId , (1, genFCall False ) ) , (concatId , (1, genConcat ) ) - , (reverseId , (1, genFCall ) ) + , (reverseId , (1, genFCall False ) ) , (iteratenId , (3, genIteraten ) ) , (iterateId , (2, genIterate ) ) , (generatenId , (3, genGeneraten ) ) , (generateId , (2, genGenerate ) ) - , (emptyId , (0, genFCall ) ) - , (singletonId , (1, genFCall ) ) - , (copynId , (2, genFCall ) ) + , (emptyId , (0, genFCall False ) ) + , (singletonId , (1, genFCall False ) ) + , (copynId , (2, genFCall False ) ) , (copyId , (1, genCopy ) ) - , (lengthTId , (1, genFCall ) ) - , (nullId , (1, genFCall ) ) + , (lengthTId , (1, genFCall False ) ) + , (nullId , (1, genFCall False ) ) , (hwxorId , (2, genOperator2 AST.Xor ) ) , (hwandId , (2, genOperator2 AST.And ) ) , (hworId , (2, genOperator2 AST.Or ) ) , (hwnotId , (1, genOperator1 AST.Not ) ) + , (plusId , (2, genOperator2 (AST.:+:) ) ) + , (timesId , (2, genOperator2 (AST.:*:) ) ) + , (negateId , (1, genOperator1 AST.Not ) ) + , (minusId , (2, genOperator2 (AST.:-:) ) ) + , (fromSizedWordId , (1, genFromSizedWord ) ) ]