From d5430e7ddf8144e724bea008c2594200018d923b Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 16 Jul 2018 15:28:58 +0100 Subject: [PATCH] clean up debug helpers (api change) --- hledger-lib/Hledger/Read/Common.hs | 4 +- hledger-lib/Hledger/Read/CsvReader.hs | 24 +- hledger-lib/Hledger/Read/JournalReader.hs | 8 +- hledger-lib/Hledger/Read/TimedotReader.hs | 16 +- hledger-lib/Hledger/Utils/Debug.hs | 255 +++++++++++----------- hledger/Hledger/Cli/Main.hs | 2 +- 6 files changed, 153 insertions(+), 156 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index e75058d8d..9d34db775 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -719,7 +719,7 @@ numberp :: Maybe AmountStyle -> TextParser m (Quantity, Int, Maybe Char, Maybe D numberp suggestedStyle = label "number" $ do -- a number is an optional sign followed by a sequence of digits possibly -- interspersed with periods, commas, or both - -- ptrace "numberp" + -- dbgparse 0 "numberp" sign <- signp rawNum <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp mExp <- optional $ try $ exponentp @@ -1214,7 +1214,7 @@ commenttagsanddatesp mYear = do bracketeddatetagsp :: Maybe Year -> TextParser m [(TagName, Day)] bracketeddatetagsp mYear1 = do - -- pdbg 0 "bracketeddatetagsp" + -- dbgparse 0 "bracketeddatetagsp" try $ do s <- lookAhead $ between (char '[') (char ']') diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index a17c066ff..823e388e3 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -441,7 +441,7 @@ rulesp = do } blankorcommentlinep :: CsvRulesParser () -blankorcommentlinep = lift (pdbg 3 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep] +blankorcommentlinep = lift (dbgparse 3 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep] blanklinep :: CsvRulesParser () blanklinep = lift (skipMany spacenonewline) >> newline >> return () "blank line" @@ -454,7 +454,7 @@ commentcharp = oneOf (";#*" :: [Char]) directivep :: CsvRulesParser (DirectiveName, String) directivep = (do - lift $ pdbg 3 "trying directive" + lift $ dbgparse 3 "trying directive" d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp) <|> (optional (char ':') >> lift (skipMany spacenonewline) >> lift eolof >> return "") @@ -477,7 +477,7 @@ directivevalp = anyChar `manyTill` lift eolof fieldnamelistp :: CsvRulesParser [CsvFieldName] fieldnamelistp = (do - lift $ pdbg 3 "trying fieldnamelist" + lift $ dbgparse 3 "trying fieldnamelist" string "fields" optional $ char ':' lift (skipSome spacenonewline) @@ -503,7 +503,7 @@ barefieldnamep = some $ noneOf (" \t\n,;#~" :: [Char]) fieldassignmentp :: CsvRulesParser (JournalFieldName, FieldTemplate) fieldassignmentp = do - lift $ pdbg 3 "trying fieldassignmentp" + lift $ dbgparse 3 "trying fieldassignmentp" f <- journalfieldnamep assignmentseparatorp v <- fieldvalp @@ -512,7 +512,7 @@ fieldassignmentp = do journalfieldnamep :: CsvRulesParser String journalfieldnamep = do - lift (pdbg 2 "trying journalfieldnamep") + lift (dbgparse 2 "trying journalfieldnamep") T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames) -- Transaction fields and pseudo fields for CSV conversion. @@ -536,7 +536,7 @@ journalfieldnames = [ assignmentseparatorp :: CsvRulesParser () assignmentseparatorp = do - lift $ pdbg 3 "trying assignmentseparatorp" + lift $ dbgparse 3 "trying assignmentseparatorp" choice [ -- try (lift (skipMany spacenonewline) >> oneOf ":="), try (lift (skipMany spacenonewline) >> char ':'), @@ -547,12 +547,12 @@ assignmentseparatorp = do fieldvalp :: CsvRulesParser String fieldvalp = do - lift $ pdbg 2 "trying fieldvalp" + lift $ dbgparse 2 "trying fieldvalp" anyChar `manyTill` lift eolof conditionalblockp :: CsvRulesParser ConditionalBlock conditionalblockp = do - lift $ pdbg 3 "trying conditionalblockp" + lift $ dbgparse 3 "trying conditionalblockp" string "if" >> lift (skipMany spacenonewline) >> optional newline ms <- some recordmatcherp as <- many (lift (skipSome spacenonewline) >> fieldassignmentp) @@ -563,7 +563,7 @@ conditionalblockp = do recordmatcherp :: CsvRulesParser [String] recordmatcherp = do - lift $ pdbg 2 "trying recordmatcherp" + lift $ dbgparse 2 "trying recordmatcherp" -- pos <- currentPos _ <- optional (matchoperatorp >> lift (skipMany spacenonewline) >> optional newline) ps <- patternsp @@ -582,20 +582,20 @@ matchoperatorp = fmap T.unpack $ choiceInState $ map string patternsp :: CsvRulesParser [String] patternsp = do - lift $ pdbg 3 "trying patternsp" + lift $ dbgparse 3 "trying patternsp" ps <- many regexp return ps regexp :: CsvRulesParser String regexp = do - lift $ pdbg 3 "trying regexp" + lift $ dbgparse 3 "trying regexp" notFollowedBy matchoperatorp c <- lift nonspace cs <- anyChar `manyTill` lift eolof return $ strip $ c:cs -- fieldmatcher = do --- pdbg 2 "trying fieldmatcher" +-- dbgparse 2 "trying fieldmatcher" -- f <- fromMaybe "all" `fmap` (optional $ do -- f' <- fieldname -- lift (skipMany spacenonewline) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index f2a18d495..311020246 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -357,7 +357,7 @@ accountaliasp = regexaliasp <|> basicaliasp basicaliasp :: TextParser m AccountAlias basicaliasp = do - -- pdbg 0 "basicaliasp" + -- dbgparse 0 "basicaliasp" old <- rstrip <$> (some $ noneOf ("=" :: [Char])) char '=' skipMany spacenonewline @@ -366,7 +366,7 @@ basicaliasp = do regexaliasp :: TextParser m AccountAlias regexaliasp = do - -- pdbg 0 "regexaliasp" + -- dbgparse 0 "regexaliasp" char '/' re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end char '/' @@ -504,7 +504,7 @@ periodictransactionp = do -- | Parse a (possibly unbalanced) transaction. transactionp :: JournalParser m Transaction transactionp = do - -- ptrace "transactionp" + -- dbgparse 0 "transactionp" startpos <- getPosition date <- datep "transaction" edate <- optional (lift $ secondarydatep date) "secondary date" @@ -628,7 +628,7 @@ postingsp mTransactionYear = many (postingp mTransactionYear) "postings" postingp :: Maybe Year -> JournalParser m Posting postingp mTransactionYear = do - -- pdbg 0 "postingp" + -- dbgparse 0 "postingp" (status, account) <- try $ do lift (skipSome spacenonewline) status <- lift statusp diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 656384ffc..bf2b28933 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -49,13 +49,13 @@ import Text.Megaparsec.Char import Hledger.Data import Hledger.Read.Common -import Hledger.Utils hiding (ptrace) +import Hledger.Utils hiding (traceParse) -- easier to toggle this here sometimes --- import qualified Hledger.Utils (ptrace) --- ptrace = Hledger.Utils.ptrace -ptrace :: Monad m => a -> m a -ptrace = return +-- import qualified Hledger.Utils (parsertrace) +-- parsertrace = Hledger.Utils.parsertrace +traceParse :: Monad m => a -> m a +traceParse = return reader :: Reader reader = Reader @@ -76,7 +76,7 @@ timedotfilep = do many timedotfileitemp where timedotfileitemp :: JournalParser m () timedotfileitemp = do - ptrace "timedotfileitemp" + traceParse "timedotfileitemp" choice [ void $ lift emptyorcommentlinep ,timedotdayp >>= \ts -> modify' (addTransactions ts) @@ -94,7 +94,7 @@ addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts) -- @ timedotdayp :: JournalParser m [Transaction] timedotdayp = do - ptrace " timedotdayp" + traceParse " timedotdayp" d <- datep <* lift eolof es <- catMaybes <$> many (const Nothing <$> try (lift emptyorcommentlinep) <|> Just <$> (notFollowedBy datep >> timedotentryp)) @@ -106,7 +106,7 @@ timedotdayp = do -- @ timedotentryp :: JournalParser m Transaction timedotentryp = do - ptrace " timedotentryp" + traceParse " timedotentryp" pos <- genericSourcePos <$> getPosition lift (skipMany spacenonewline) a <- modifiedaccountnamep diff --git a/hledger-lib/Hledger/Utils/Debug.hs b/hledger-lib/Hledger/Utils/Debug.hs index 2473cc835..e792fd8b4 100644 --- a/hledger-lib/Hledger/Utils/Debug.hs +++ b/hledger-lib/Hledger/Utils/Debug.hs @@ -8,7 +8,38 @@ -- http://hackage.haskell.org/packages/archive/traced/2009.7.20/doc/html/Debug-Traced.html module Hledger.Utils.Debug ( - module Hledger.Utils.Debug + pprint + ,pshow + ,ptrace + ,traceWith + ,debugLevel + ,ptraceAt + ,dbg0 + ,dbgExit + ,dbg1 + ,dbg2 + ,dbg3 + ,dbg4 + ,dbg5 + ,dbg6 + ,dbg7 + ,dbg8 + ,dbg9 + ,ptraceAtIO + ,dbg0IO + ,dbg1IO + ,dbg2IO + ,dbg3IO + ,dbg4IO + ,dbg5IO + ,dbg6IO + ,dbg7IO + ,dbg8IO + ,dbg9IO + ,plog + ,plogAt + ,traceParse + ,dbgparse ,module Debug.Trace ) where @@ -27,31 +58,22 @@ import Text.Megaparsec import Text.Printf import Text.Show.Pretty (ppShow, pPrint) --- | Easier alias for pretty-show's pPrint. +-- | Pretty print. Easier alias for pretty-show's pPrint. pprint :: Show a => a -> IO () pprint = pPrint --- | Easier alias for pretty-show's ppShow. +-- | Pretty show. Easier alias for pretty-show's ppShow. pshow :: Show a => a -> String pshow = ppShow +-- | Pretty trace. Easier alias for traceShowId + ppShow. +ptrace :: Show a => a -> a +ptrace = traceWith pshow + -- | Trace (print to stderr) a showable value using a custom show function. traceWith :: (a -> String) -> a -> a traceWith f a = trace (f a) a --- | Parsec trace - show the current parsec position and next input, --- and the provided label if it's non-null. -ptrace :: String -> TextParser m () -ptrace msg = do - pos <- getPosition - next <- (T.take peeklength) `fmap` getInput - let (l,c) = (sourceLine pos, sourceColumn pos) - s = printf "at line %2d col %2d: %s" (unPos l) (unPos c) (show next) :: String - s' = printf ("%-"++show (peeklength+30)++"s") s ++ " " ++ msg - trace s' $ return () - where - peeklength = 30 - -- | Global debug level, which controls the verbosity of debug output -- on the console. The default is 0 meaning no debug output. The -- @--debug@ command line flag sets it to 1, or @--debug=N@ sets it to @@ -75,105 +97,109 @@ debugLevel = case snd $ break (=="--debug") args of where args = unsafePerformIO getArgs --- | Convenience aliases for tracePrettyAt. +-- | Pretty-print a label and a showable value to the console +-- if the global debug level is at or above the specified level. +-- At level 0, always prints. Otherwise, uses unsafePerformIO. +ptraceAt :: Show a => Int -> String -> a -> a +ptraceAt level + | level > 0 && debugLevel < level = flip const + | otherwise = \s a -> let p = ppShow a + ls = lines p + nlorspace | length ls > 1 = "\n" + | otherwise = " " ++ take (10 - length s) (repeat ' ') + ls' | length ls > 1 = map (" "++) ls + | otherwise = ls + in trace (s++":"++nlorspace++intercalate "\n" ls') a --- Always pretty-print a message and the showable value to the console, then return it. --- ("dbg" without the 0 clashes with megaparsec 5.1). +-- | Pretty-print a message and the showable value to the console, then return it. dbg0 :: Show a => String -> a -> a -dbg0 = tracePrettyAt 0 +dbg0 = ptraceAt 0 +-- "dbg" would clash with megaparsec --- | Pretty-print a message and the showable value to the console when the debug level is >= 1, then return it. Uses unsafePerformIO. +-- | Like dbg0, but also exit the program. Uses unsafePerformIO. +dbgExit :: Show a => String -> a -> a +dbgExit msg = const (unsafePerformIO exitFailure) . dbg0 msg + +-- | Pretty-print a message and the showable value to the console when the global debug level is >= 1, then return it. +-- Uses unsafePerformIO. dbg1 :: Show a => String -> a -> a -dbg1 = tracePrettyAt 1 +dbg1 = ptraceAt 1 dbg2 :: Show a => String -> a -> a -dbg2 = tracePrettyAt 2 +dbg2 = ptraceAt 2 dbg3 :: Show a => String -> a -> a -dbg3 = tracePrettyAt 3 +dbg3 = ptraceAt 3 dbg4 :: Show a => String -> a -> a -dbg4 = tracePrettyAt 4 +dbg4 = ptraceAt 4 dbg5 :: Show a => String -> a -> a -dbg5 = tracePrettyAt 5 +dbg5 = ptraceAt 5 dbg6 :: Show a => String -> a -> a -dbg6 = tracePrettyAt 6 +dbg6 = ptraceAt 6 dbg7 :: Show a => String -> a -> a -dbg7 = tracePrettyAt 7 +dbg7 = ptraceAt 7 dbg8 :: Show a => String -> a -> a -dbg8 = tracePrettyAt 8 +dbg8 = ptraceAt 8 dbg9 :: Show a => String -> a -> a -dbg9 = tracePrettyAt 9 +dbg9 = ptraceAt 9 --- | Convenience aliases for tracePrettyAtIO. --- Like dbg, but convenient to insert in an IO monad. --- XXX These have a bug; they should use traceIO, not trace, --- otherwise GHC can occasionally over-optimise +-- | Like ptraceAt, but convenient to insert in an IO monad (plus +-- convenience aliases). +-- XXX These have a bug; they should use +-- traceIO, not trace, otherwise GHC can occasionally over-optimise -- (cf lpaste a few days ago where it killed/blocked a child thread). +ptraceAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m () +ptraceAtIO lvl lbl x = liftIO $ ptraceAt lvl lbl x `seq` return () + +-- XXX Could not deduce (a ~ ()) +-- ptraceAtM :: (Monad m, Show a) => Int -> String -> a -> m a +-- ptraceAtM lvl lbl x = ptraceAt lvl lbl x `seq` return x + dbg0IO :: (MonadIO m, Show a) => String -> a -> m () -dbg0IO = tracePrettyAtIO 0 +dbg0IO = ptraceAtIO 0 dbg1IO :: (MonadIO m, Show a) => String -> a -> m () -dbg1IO = tracePrettyAtIO 1 +dbg1IO = ptraceAtIO 1 dbg2IO :: (MonadIO m, Show a) => String -> a -> m () -dbg2IO = tracePrettyAtIO 2 +dbg2IO = ptraceAtIO 2 dbg3IO :: (MonadIO m, Show a) => String -> a -> m () -dbg3IO = tracePrettyAtIO 3 +dbg3IO = ptraceAtIO 3 dbg4IO :: (MonadIO m, Show a) => String -> a -> m () -dbg4IO = tracePrettyAtIO 4 +dbg4IO = ptraceAtIO 4 dbg5IO :: (MonadIO m, Show a) => String -> a -> m () -dbg5IO = tracePrettyAtIO 5 +dbg5IO = ptraceAtIO 5 dbg6IO :: (MonadIO m, Show a) => String -> a -> m () -dbg6IO = tracePrettyAtIO 6 +dbg6IO = ptraceAtIO 6 dbg7IO :: (MonadIO m, Show a) => String -> a -> m () -dbg7IO = tracePrettyAtIO 7 +dbg7IO = ptraceAtIO 7 dbg8IO :: (MonadIO m, Show a) => String -> a -> m () -dbg8IO = tracePrettyAtIO 8 +dbg8IO = ptraceAtIO 8 dbg9IO :: (MonadIO m, Show a) => String -> a -> m () -dbg9IO = tracePrettyAtIO 9 +dbg9IO = ptraceAtIO 9 --- | Pretty-print a message and a showable value to the console if the debug level is at or above the specified level. --- At level 0, always prints. Otherwise, uses unsafePerformIO. -tracePrettyAt :: Show a => Int -> String -> a -> a -tracePrettyAt lvl = dbgppshow lvl - --- tracePrettyAtM :: (Monad m, Show a) => Int -> String -> a -> m a --- tracePrettyAtM lvl lbl x = tracePrettyAt lvl lbl x `seq` return x --- XXX Could not deduce (a ~ ()) --- from the context (Show a) --- bound by the type signature for --- dbgM :: Show a => String -> a -> IO () --- at hledger/Hledger/Cli/Main.hs:200:13-42 --- ‘a’ is a rigid type variable bound by --- the type signature for dbgM :: Show a => String -> a -> IO () --- at hledger/Hledger/Cli/Main.hs:200:13 --- Expected type: String -> a -> IO () --- Actual type: String -> a -> IO a - -tracePrettyAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m () -tracePrettyAtIO lvl lbl x = liftIO $ tracePrettyAt lvl lbl x `seq` return () - -log0 :: Show a => String -> a -> a -log0 = logPrettyAt 0 +-- | Log a message and a pretty-printed showable value to ./debug.log, then return it. +plog :: Show a => String -> a -> a +plog = plogAt 0 -- | Log a message and a pretty-printed showable value to ./debug.log, --- if the debug level is at or above the specified level. +-- if the global debug level is at or above the specified level. -- At level 0, always logs. Otherwise, uses unsafePerformIO. -logPrettyAt :: Show a => Int -> String -> a -> a -logPrettyAt lvl +plogAt :: Show a => Int -> String -> a -> a +plogAt lvl | lvl > 0 && debugLevel < lvl = flip const | otherwise = \s a -> let p = ppShow a @@ -185,66 +211,37 @@ logPrettyAt lvl output = s++":"++nlorspace++intercalate "\n" ls' in unsafePerformIO $ appendFile "debug.log" output >> return a --- | print this string to the console before evaluating the expression, --- if the global debug level is at or above the specified level. Uses unsafePerformIO. --- dbgtrace :: Int -> String -> a -> a --- dbgtrace level --- | debugLevel >= level = trace --- | otherwise = flip const +-- XXX redundant ? More/less robust than log0 ? +-- -- | Like dbg, but writes the output to "debug.log" in the current directory. +-- -- Uses unsafePerformIO. Can fail due to log file contention if called too quickly +-- -- ("*** Exception: debug.log: openFile: resource busy (file is locked)"). +-- dbglog :: Show a => String -> a -> a +-- dbglog label a = +-- (unsafePerformIO $ +-- appendFile "debug.log" $ label ++ ": " ++ ppShow a ++ "\n") +-- `seq` a --- | Print a showable value to the console, with a message, if the --- debug level is at or above the specified level (uses --- unsafePerformIO). --- Values are displayed with show, all on one line, which is hard to read. --- dbgshow :: Show a => Int -> String -> a -> a --- dbgshow level --- | debugLevel >= level = ltrace --- | otherwise = flip const +-- | Print the provided label (if non-null) and current parser state +-- (position and next input) to the console. (See also megaparsec's dbg.) +traceParse :: String -> TextParser m () +traceParse msg = do + pos <- getPosition + next <- (T.take peeklength) `fmap` getInput + let (l,c) = (sourceLine pos, sourceColumn pos) + s = printf "at line %2d col %2d: %s" (unPos l) (unPos c) (show next) :: String + s' = printf ("%-"++show (peeklength+30)++"s") s ++ " " ++ msg + trace s' $ return () + where + peeklength = 30 --- | Print a showable value to the console, with a message, if the --- debug level is at or above the specified level (uses --- unsafePerformIO). --- Values are displayed with ppShow, each field/constructor on its own line. -dbgppshow :: Show a => Int -> String -> a -> a -dbgppshow level - | level > 0 && debugLevel < level = flip const - | otherwise = \s a -> let p = ppShow a - ls = lines p - nlorspace | length ls > 1 = "\n" - | otherwise = " " ++ take (10 - length s) (repeat ' ') - ls' | length ls > 1 = map (" "++) ls - | otherwise = ls - in trace (s++":"++nlorspace++intercalate "\n" ls') a +-- | Print the provided label (if non-null) and current parser state +-- (position and next input) to the console if the global debug level +-- is at or above the specified level. Uses unsafePerformIO. +-- (See also megaparsec's dbg.) +traceParseAt :: Int -> String -> TextParser m () +traceParseAt level msg = when (level <= debugLevel) $ traceParse msg --- -- | Print a showable value to the console, with a message, if the --- -- debug level is at or above the specified level (uses --- -- unsafePerformIO). --- -- Values are displayed with pprint. Field names are not shown, but the --- -- output is compact with smart line wrapping, long data elided, --- -- and slow calculations timed out. --- dbgpprint :: Data a => Int -> String -> a -> a --- dbgpprint level msg a --- | debugLevel >= level = unsafePerformIO $ do --- pprint a >>= putStrLn . ((msg++": \n") ++) . show --- return a --- | otherwise = a +-- | Convenience alias for traceParseAt +dbgparse :: Int -> String -> TextParser m () +dbgparse level msg = traceParseAt level msg --- | Like dbg, then exit the program. Uses unsafePerformIO. -dbgExit :: Show a => String -> a -> a -dbgExit msg = const (unsafePerformIO exitFailure) . dbg0 msg - --- | Print a message and parsec debug info (parse position and next --- input) to the console when the debug level is at or above --- this level. Uses unsafePerformIO. --- pdbgAt :: GenParser m => Float -> String -> m () -pdbg :: Int -> String -> TextParser m () -pdbg level msg = when (level <= debugLevel) $ ptrace msg - --- | Like dbg, but writes the output to "debug.log" in the current directory. --- Uses unsafePerformIO. Can fail due to log file contention if called too quickly --- ("*** Exception: debug.log: openFile: resource busy (file is locked)"). -dbglog :: Show a => String -> a -> a -dbglog label a = - (unsafePerformIO $ - appendFile "debug.log" $ label ++ ": " ++ ppShow a ++ "\n") - `seq` a diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index caf7bd006..37a9adb93 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -115,7 +115,7 @@ main = do (argsbeforecmd, argsaftercmd') = break (==rawcmd) args argsaftercmd = drop 1 argsaftercmd' dbgIO :: Show a => String -> a -> IO () - dbgIO = tracePrettyAtIO 2 + dbgIO = ptraceAtIO 2 dbgIO "running" prognameandversion dbgIO "raw args" args