CountTokens.hs

module Main where

import Control.Monad (mapM_)
import Control.Monad.Trans.Resource (runResourceT)
import Data.Conduit
import Data.Conduit.Attoparsec (conduitParser)
import Data.Conduit.Binary (sourceFile)
import qualified Data.Conduit.List as CL
import System.Environment (getArgs)

import Lexis (anyToken)

main :: IO ()
main = getArgs >>= mapM_ process

process :: FilePath -> IO ()
process filePath =
    runResourceT (input $$ parser =$ toOnes =$ counter) >>= print
  where
    input   = sourceFile filePath
    parser  = conduitParser anyToken
    toOnes  = CL.map (const 1)
    counter = CL.fold (+) 0

Lexis.hs

module Lexis where

import Control.Applicative
import Data.Attoparsec.ByteString
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (pack)
import Data.Char (ord)
import Data.Word (Word8)
import Prelude hiding (takeWhile)

import Tables

anyToken = whitespace
       <|> anyKeyword
       <|> identifier
       <|> characterLiteral
       <|> stringLiteral
       <|> symbol

-- |Whitespace token (HT, LF, VT, FF, or CR)
whitespace = takeWhile1 pred <?> "whitespace"
  where
    pred c = c == ch ' ' || (c >= ch '\b' && c <= ch '\r')

anyKeyword = choice $ map (string . pack) keywords

identifier = takeWhile1 pred <?> "identifier"
  where
    pred c = c >= ch '0' && c <= ch '9' ||
             c >= ch 'A' && c <= ch 'Z' ||
             c >= ch 'a' && c <= ch 'z' ||
             c == ch '_'

characterLiteral = takeWhile (/= ch '\'') `enclosedBy` word8 (ch '\'')

stringLiteral = takeWhile (/= ch '"') `enclosedBy` word8 (ch '"')

symbol = choice $ map (string . pack) symbols

enclosedBy :: Parser a -> Parser b -> Parser a
inner `enclosedBy` delimiter = delimiter *> inner <* delimiter

ch :: Char -> Word8
ch = fromIntegral . ord

Tables.hs

module Tables where

keywords :: [String]
keywords =
    [ "auto"
    , "break"
    , "case"
    , "char"
    , "const"
    , "continue"
    , "default"
    , "do"
    , "double"
    , "else"
    , "enum"
    , "extern"
    , "float"
    , "for"
    , "goto"
    , "if"
    , "int"
    , "long"
    , "register"
    , "return"
    , "short"
    , "signed"
    , "sizeof"
    , "static"
    , "struct"
    , "switch"
    , "typedef"
    , "union"
    , "unsigned"
    , "void"
    , "volatile"
    , "while"
    ]

simpleEscapes :: [(Char, Char)]
simpleEscapes =
    [ ('\'', '\'')
    , ('"',  '"')
    , ('?',  '?')
    , ('\\', '\\')
    , ('a',  '\a')
    , ('b',  '\b')
    , ('f',  '\f')
    , ('n',  '\n')
    , ('r',  '\r')
    , ('t',  '\t')
    , ('v',  '\v')
    ]

symbols :: [String]
symbols =
    [ "["
    , "]"
    , "("
    , ")"
    , "{"
    , "}"
    , "."
    , "->"
    , "++"
    , "--"
    , "&"
    , "*"
    , "+"
    , "-"
    , "~"
    , "!"
    , "/"
    , "%"
    , "<<"
    , ">>"
    , "<"
    , ">"
    , "<="
    , ">="
    , "=="
    , "!="
    , "^"
    , "|"
    , "&&"
    , "||"
    , "?"
    , ":"
    , "="
    , "*="
    , "/="
    , "%="
    , "+="
    , "-="
    , "<<="
    , ">>="
    , "&="
    , "^="
    , "|="
    , ","
    , "#"
    , "##"
    , ";"
    , "..."
    ]