clexer (empty) → 0.1.0.0

raw patch · 6 files changed

+853/−0 lines, 6 filesdep +basedep +containersdep +mtlsetup-changed

Dependencies added: base, containers, mtl, parsec

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• clexer.cabal +21/−0
• src/Language/Cpp/Lex.hs +383/−0
• src/Language/Cpp/Pretty.hs +297/−0
• src/Language/Cpp/SyntaxToken.hs +120/−0

@@ -0,0 +1,30 @@+Copyright (c) 2018, Thomas Eding
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Thomas Eding nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,21 @@+-- Initial clexer.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                clexer
+version:             0.1.0.0
+synopsis:            Lexes C++ code into simple tokens
+-- description:         
+license:             BSD3
+license-file:        LICENSE
+author:              Thomas Eding
+maintainer:          thomasedingcode@gmail.com
+-- copyright:           
+-- category:            
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:     Language.Cpp.Lex, Language.Cpp.Pretty, Language.Cpp.SyntaxToken
+  other-modules:       
+  build-depends:       base >=4.10 && <4.11, mtl >=2.2 && <2.3, containers >=0.5 && <0.6, parsec >=3.1 && <3.2
+  hs-source-dirs:      src

@@ -0,0 +1,383 @@+{-# LANGUAGE FlexibleContexts #-}
+
+module Language.Cpp.Lex (
+      main
+    , runLexer
+    , ParseError
+    ) where
+
+
+import Control.Exception (assert)
+import Data.Char
+import Data.List
+import Data.Monoid
+import Data.Ratio
+import Data.Set (Set)
+import qualified Data.Set as S
+import Language.Cpp.Pretty
+import Language.Cpp.SyntaxToken
+import Numeric
+import Text.Parsec hiding (newline)
+import Text.Parsec.String
+
+
+type Lexer = Parser
+
+
+main :: IO ()
+main = do
+    str <- getContents
+    case runLexer str of
+        Left err -> print err
+        Right toks -> putStrLn $ pretty (ignoreExt :: () -> [SyntaxToken ()]) toks
+
+
+runLexer :: (Eq a) => String -> Either ParseError [SyntaxToken a]
+runLexer = runParser lexC () ""
+
+
+lexC :: (Eq a) => Lexer [SyntaxToken a]
+lexC = do
+    many space
+    toks <- many (lexSyntaxToken >>= \ts -> many space >> return ts)
+    eof
+    return $ negateNumbers toks
+
+
+negateNumbers :: (Eq a) => [SyntaxToken a] -> [SyntaxToken a]
+negateNumbers tokens = case tokens of
+    t1 : t2 : t3 : ts -> let
+        continue = t1 : (negateNumbers $ t2 : t3 : ts)
+        tryNegateAndContinue = case negateNumber t3 of
+            Nothing -> continue
+            Just t -> t1 : t : negateNumbers ts
+        in if t2 == Punctuation (punc "-")
+            then case t1 of
+                Punctuation {} -> tryNegateAndContinue
+                Keyword {} -> tryNegateAndContinue
+                _ -> continue
+            else continue
+    Punctuation p : t : ts -> let
+        continue = Punctuation p : (negateNumbers $ t : ts)
+        in if p == punc "-"
+            then case negateNumber t of
+                Nothing -> continue
+                Just t' -> [t']
+            else continue
+    t : ts -> t : negateNumbers ts
+    [] -> []
+
+
+negateNumber :: SyntaxToken a -> Maybe (SyntaxToken a)
+negateNumber t = case t of
+    Integer n -> Just $ Integer $ negate n
+    Floating x -> Just $ Floating $ negate x
+    _ -> Nothing
+
+
+newline :: Lexer ()
+newline = do
+    c <- oneOf "\r\n"
+    case c of 
+        '\r' -> optional $ char '\n'
+        '\n' -> optional $ char '\r'
+
+
+lexSyntaxToken :: Lexer (SyntaxToken a)
+lexSyntaxToken = parserZero
+    <|> lexComment --> const Comment
+    <|> lexString --> String
+    <|> lexChar --> Char
+    <|> try lexFloating --> Floating
+    <|> lexInteger --> Integer
+    <|> lexDirective
+    <|> lexPunctuation --> Punctuation
+    <|> lexKeyword --> Keyword
+    <|> lexIdentifier --> Identifier
+    where
+        infix 2 -->
+        p --> f = fmap f p
+
+
+lexComment :: Lexer ()
+lexComment = lexLineComment <|> lexBlockComment
+
+
+lexLineComment :: Lexer ()
+lexLineComment = do
+    try $ string "//"
+    many $ noneOf "\r\n"
+    return ()
+
+
+lexBlockComment :: Lexer ()
+lexBlockComment = do
+    try $ string "/*"
+    many nonClosing
+    string "*/"
+    return ()
+    where
+        nonClosing = do
+            future <- lookAhead $ do
+                c1 <- anyChar
+                c2 <- anyChar
+                return [c1, c2]
+            if future == "*/"
+                then parserZero
+                else anyChar
+
+
+line :: Lexer String
+line = many $ noneOf "\r\n"
+
+
+wholeWord :: String -> Lexer String
+wholeWord str = do
+    string str
+    notFollowedBy $ alphaNum <|> char '_'
+    return str
+
+
+lexDirective :: Lexer (SyntaxToken a)
+lexDirective = do
+    char '#'
+    many space
+    res <- lexInclude
+        <|> lexDefine
+        <|> lexIf
+        <|> lexIfdef
+        <|> lexIfndef
+        <|> lexEndif
+    return $ Directive res
+
+
+lexIf :: Lexer Directive
+lexIf = do
+    try $ wholeWord "if"
+    many space
+    code <- line
+    return $ If code
+
+
+lexIfdef :: Lexer Directive
+lexIfdef = do
+    try $ wholeWord "ifdef"
+    many space
+    code <- line
+    return $ Ifdef code
+
+
+lexIfndef :: Lexer Directive
+lexIfndef = do
+    try $ wholeWord "ifndef"
+    many space
+    code <- line
+    return $ Ifndef code
+
+
+lexEndif :: Lexer Directive
+lexEndif = do
+    try $ wholeWord "endif"
+    return Endif
+
+
+lexInclude :: Lexer Directive
+lexInclude = do
+    try $ wholeWord "include"
+    many1 space
+    path <- lexString <|> lexBracketString
+    return $ Include path
+
+
+lexDefine :: Lexer Directive
+lexDefine = do
+    try $ wholeWord "define"
+    many1 space
+    name <- lexIdentifier
+    mArgs <- optionMaybe $ do
+        char '('
+        args <- (many space >> lexIdentifier >>= \i -> many space >> return i) `sepBy` char ','
+        char ')'
+        return args
+    many space
+    code <- line
+    return $ Define name mArgs code
+
+
+lexPunctuation :: Lexer Punctuation
+lexPunctuation = do
+    cs <- lookAhead $ many1 $ oneOf punctuationChars
+    let possiblePuncs = reverse $ inits cs
+        mPunc = mconcat $ flip map possiblePuncs $ \possPunc -> if punc possPunc `S.member` punctuationSet
+            then First $ Just possPunc
+            else First Nothing
+    case getFirst mPunc of
+        Nothing -> parserZero
+        Just p -> string p >> return (punc p)
+    
+
+punctuationChars :: [Char]
+punctuationChars = nub $ concat $ map unpunc puncs
+
+
+punctuationSet :: Set Punctuation
+punctuationSet = S.fromList puncs
+
+
+lexKeyword :: Lexer Keyword
+lexKeyword = do
+    ident <- lookAhead lexIdentifier
+    if kw ident `S.member` keywordSet
+        then string ident >> return (kw ident)
+        else parserZero
+
+
+keywordSet :: Set Keyword
+keywordSet = S.fromList keywords
+
+
+-- TODO: This function needs to properly parse 1e3 and 1e-3 (Note: There are no decimal points here.)
+lexFloating :: Lexer Rational
+lexFloating = do
+    beforeDecimal <- lexBase 10
+    char '.'
+    afterDecimal <- lexBase 10
+    exponent <- option 0 $ do
+        oneOf "eE"
+        signFunc <- option id $ do
+            c <- oneOf "-+"
+            return $ case c of
+                '-' -> negate
+                '+' -> id
+                _ -> assert False undefined
+        fmap signFunc $ lexBase 10
+    optional $ oneOf "fF"
+    let afterDecimalDigits = case reverse $ dropWhile (== '0') $ reverse $ show afterDecimal of
+            "" -> "0"
+            ds -> ds
+        numer = read $ show beforeDecimal ++ afterDecimalDigits
+        denom = 10 ^ genericLength afterDecimalDigits
+    return $ (numer % denom) * (10 ^^ exponent)
+
+
+lexInteger :: Lexer Integer
+lexInteger = do
+    next <- lookAhead anyChar
+    num <- case next of
+        '0' -> do
+            next' <- lookAhead $ anyChar >> anyChar
+            case next' of
+                'x' -> anyChar >> anyChar >> lexBase 16
+                _ -> lexBase 8
+        _ -> lexBase 10
+    many $ oneOf "uUlL"
+    return num
+
+
+lexIdentifier :: Lexer Identifier
+lexIdentifier = do
+    first <- letter <|> char '_'
+    rest <- many $ alphaNum <|> char '_'
+    return $ first : rest
+
+
+lexRawChar :: [Char] -> Lexer Char
+lexRawChar extraSpecials = lexEscapedChar <|> satisfy simple
+    where
+        special = flip elem $ '\\' : extraSpecials
+        simple c = ' ' <= c && c <= '~' && not (special c)
+
+
+lexEscapedChar :: Lexer Char
+lexEscapedChar = do
+    char '\\'
+    escapeSymbol <- lookAhead anyChar
+    mEscapedChar <- case escapeSymbol of
+        '\''-> yield '\''
+        '"' -> yield '"'
+        '?' -> yield '?'
+        '\\'-> yield '\\'
+        'a' -> yield '\a'
+        'b' -> yield '\b'
+        'f' -> yield '\f'
+        'n' -> yield '\n'
+        'r' -> yield '\r'
+        't' -> yield '\t'
+        'v' -> yield '\v'
+        '0' -> yieldOct
+        '1' -> yieldOct
+        '2' -> yieldOct
+        '3' -> yieldOct
+        '4' -> yieldOct
+        '5' -> yieldOct
+        '6' -> yieldOct
+        '7' -> yieldOct
+        'x' -> yieldHex
+        _ -> return Nothing
+    case mEscapedChar of
+        Just c -> return c
+        Nothing -> parserZero <?> "escape sequence"
+    where
+        yield c = anyChar >> return (Just c)
+        yieldOct = fmap Just lexOctChar
+        yieldHex = fmap Just lexHexChar
+
+
+lexOctChar :: Lexer Char
+lexOctChar = fmap (chr . fromIntegral) $ lexBase 8
+
+
+lexHexChar :: Lexer Char
+lexHexChar = char 'x' >> (fmap (chr . fromIntegral) $ lexBase 16)
+
+
+type Base = Int
+
+
+lexBase :: Base -> Lexer Integer
+lexBase base = do
+    ds <- many1 $ satisfy isBaseDigit
+    case readInt (fromIntegral base) isBaseDigit toInteger ds of
+        [(n, "")] -> return n
+        _ -> parserZero
+    where
+        possibleDigits = take base $ ['0' .. '9'] ++ ['a' .. 'z']
+        isBaseDigit c = toLower c `elem` possibleDigits
+        toInteger c = maybe (error errorMsg) id $ toLower c `elemIndex` possibleDigits
+            where
+                errorMsg = "lexBase"
+
+
+lexString :: Lexer String
+lexString = do
+    parts <- many1 (lexString' >>= \s -> many space >> return s)
+    return $ concat parts
+
+
+lexString' :: Lexer String
+lexString' = do
+    char '"'
+    str <- many $ lexRawChar "\""
+    char '"'
+    return str
+
+
+lexChar :: Lexer Char
+lexChar = do
+    char '\''
+    c <- lexRawChar "'"
+    char '\''
+    return c
+
+
+lexBracketString :: Lexer String
+lexBracketString = do
+    char '<'
+    str <- many $ lexRawChar ">"
+    char '>'
+    return str
+
+
+
+
+

@@ -0,0 +1,297 @@+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Language.Cpp.Pretty (
+      pretty
+    , ignoreExt
+    ) where
+
+
+import Control.Monad.State
+import Control.Monad.Writer hiding (tell)
+import qualified Control.Monad.Writer as W
+import Data.Char
+import Data.Function
+import Data.List
+import Language.Cpp.SyntaxToken
+import Numeric
+
+
+type Pretty = WriterT String (State PrettyState)
+
+
+data PrettyState = St {
+      prev :: SyntaxToken ()
+    , spaceAtEnd :: Maybe Char
+    }
+
+
+tell :: String -> Pretty ()
+tell "" = return ()
+tell s = do
+    mLastSpace <- gets spaceAtEnd
+    let (s', mLastSpace') = squashSpaces $ maybe s (\c -> c : s) mLastSpace
+    W.tell s'
+    modify $ \st -> st { spaceAtEnd = mLastSpace' }
+
+
+tabify :: String -> String
+tabify = unlines . flip evalState 0 . mapM tabifyM . lines
+
+
+tabifyM :: String -> State Int String
+tabifyM "" = return ""
+tabifyM str = do
+    case head str of
+        '}' -> modify (subtract 1)
+        _ -> return ()
+    tabs <- gets $ flip replicate '\t'
+    case last str of
+        '{' -> modify (+1)
+        _ -> return ()
+    return $ tabs ++ str
+
+
+squashSpaces :: String -> (String, Maybe Char)
+squashSpaces = flip runState Nothing . squashSpacesM
+
+
+squashSpacesM :: String -> State (Maybe Char) String
+squashSpacesM "" = return ""
+squashSpacesM [c] = if isSpace c
+    then gets (maybe c (bestSpace c)) >>= put . Just >> return ""
+    else return [c]
+squashSpacesM (c:c':cs) = if isSpace c
+    then if isSpace c'
+        then squashSpacesM $ bestSpace c c' : cs
+        else fmap (c :) $ squashSpacesM (c':cs)
+    else fmap (c :) $ squashSpacesM (c':cs)
+
+
+prioritizeSpace :: Char -> Int
+prioritizeSpace c = maybe maxBound id $ c `elemIndex` "\n\r\t "
+
+
+bestSpace :: Char -> Char -> Char
+bestSpace c = snd . on min (\c -> (prioritizeSpace c, c)) c
+
+
+ignoreExt :: a -> [SyntaxToken ()]
+ignoreExt _ = []
+
+
+pretty :: (a -> [SyntaxToken ()]) -> [SyntaxToken a] -> String
+pretty f = unlines . filter (not . all isSpace) . lines
+    . tabify
+    . dropWhile isSpace
+    . flip evalState st . execWriterT
+    . mapM_ prettyToken
+    . filter (`notElem` [Comment, Ext ()])
+    . concatMap f'
+    where
+        st = St {
+              prev = Comment
+            , spaceAtEnd = Just ' '
+            }
+        f' tok = case tok of
+            Ext x -> f x
+            _ -> [fmap (const ()) tok]
+
+
+prettyToken :: SyntaxToken () -> Pretty ()
+prettyToken tok = do
+    case tok of
+        String s -> spacedNormally $ '"' : escape s ++ "\""
+        Char c -> spacedNormally $ '\'' : escape c ++ "'"
+        Integer n -> spacedNormally $ show n
+        Floating x -> spacedNormally $ show (fromRational x :: Double)
+        Identifier name -> spacedNormally name
+        Directive d -> prettyDirective d
+        Punctuation p -> prettyPunc p
+        Keyword k -> do
+            spacedNormally $ unkw k
+            if k `elem` map kw ["for", "if", "return", "switch", "throw", "while"]
+                then tell " "
+                else return ()
+    modify $ \st -> st { prev = tok }
+    where
+        spacedNormally = spacedLeftBy $ \t -> case t of
+            Identifier {} -> True
+            Keyword {} -> True
+            Punctuation p -> p == punc ")"
+            _ -> False
+
+
+spacedLeftBy :: (SyntaxToken () -> Bool) -> String -> Pretty ()
+spacedLeftBy pred msg = do
+    prevTok <- gets prev
+    if pred prevTok
+        then spacedLeft msg
+        else tell msg
+
+
+prettyDirective :: Directive -> Pretty ()
+prettyDirective d = do
+    tell "#"
+    case d of
+        Include path -> tell $ "include \"" ++ escape path ++ "\""
+        Define name mArgs code -> do
+            tell $ "define " ++ name
+            case mArgs of
+                Nothing -> return ()
+                Just args -> tell $ '(' : intercalate ", " args ++ ")"
+            tell $ ' ' : code
+        If code -> tell $ "if " ++ code
+        Ifdef code -> tell $ "ifdef " ++ code
+        Ifndef code -> tell $ "ifndef " ++ code
+        Endif -> tell "endif"
+    tell "\n"
+
+
+makesNextUnary :: SyntaxToken () -> Bool
+makesNextUnary tok = case tok of
+    Punctuation p -> p `elem` (map punc $ words ", - + * / ! ^ & ? : | < > = == !=  %= ^= &= *= -= += |= <= >= <<= >>= && || [ ( { ;")
+    Keyword k -> k `elem` (map kw $ ["delete", "else", "return", "sizeof", "throw"] ++ ["and", "and_eq", "bitand", "bitor", "not"])
+    Directive {} -> True
+    _ -> False
+
+
+prettyPunc :: Punctuation -> Pretty ()
+prettyPunc punctuation = do
+    let p = unpunc punctuation
+    prevTok <- gets prev
+    case p of
+        "," -> unspacedLeft $ spacedRight p
+        ";" -> unspacedLeft $ p ++ "\n"
+        "!" -> spacedLeft p
+        "%" -> spaced p
+        "^" -> spaced p
+        "&" -> if makesNextUnary prevTok
+            then spacedLeft p
+            else spaced p
+        "*" -> if makesNextUnary prevTok
+            then spacedLeft p
+            else spaced p
+        "-" -> if makesNextUnary prevTok
+            then spacedLeft p
+            else spaced p
+        "+" -> spaced p
+        "/" -> spaced p
+        "?" -> spaced p
+        ":" -> spaced p
+        "|" -> spaced p
+        "<" -> spaced p
+        ">" -> spaced p
+        "=" -> spaced p
+        "==" -> spaced p
+        "!=" -> spaced p
+        "%=" -> spaced p
+        "^=" -> spaced p
+        "&=" -> spaced p
+        "*=" -> spaced p
+        "-=" -> spaced p
+        "+=" -> spaced p
+        "|=" -> spaced p
+        "<=" -> spaced p
+        ">=" -> spaced p
+        "<<=" -> spaced p
+        ">>=" -> spaced p
+        "<<" -> spaced p
+        ">>" -> spaced p
+        "&&" -> spaced p
+        "||" -> spaced p
+        "::" -> tell p
+        "->*" -> tell p
+        "->" -> tell p
+        ".*" -> tell p
+        "." -> tell p
+        "[" -> tell p
+        "]" -> unspacedLeft p
+        "(" -> tell p
+        ")" -> unspacedLeft p
+        "{" -> spacedLeft $ p ++ "\n"
+        "}" -> tell $ '\n' : p ++ "\n"
+
+
+unspacedLeft :: String -> Pretty ()
+unspacedLeft s = do
+    modify $ \st -> case spaceAtEnd st of
+        Nothing -> st
+        Just c -> if c `elem` " \t"
+            then st { spaceAtEnd = Nothing }
+            else st
+    tell s
+
+spaced :: String -> Pretty ()
+spaced s = spacedLeft s >> tell " "
+
+
+spacedLeft :: String -> Pretty ()
+spacedLeft s = do
+    prevTok <- gets prev
+    case prevTok of
+        Punctuation p -> if unpunc p `elem` ["(", "[", "{", "}"]
+            then return ()
+            else tell " "
+        _ -> tell " "
+    tell s
+
+
+spacedRight :: String -> String
+spacedRight s = s ++ " "
+
+
+class Escape a where
+    escape :: a -> String
+
+
+instance Escape Char where
+    escape = flip evalState Nothing . escapeM
+
+
+instance Escape String where
+    escape = concat . flip evalState Nothing . mapM escapeM
+
+
+escapeM :: Char -> State (Maybe String) String
+escapeM c = do
+    c' <- case c of
+        '\'' -> return "\\'"
+        '"'  -> return "\\\""
+        '?'  -> do
+            prev <- get
+            if prev == Just "?"
+                then return "\\?"
+                else return "?"
+        '\\' -> return "\\\\"
+        '\a' -> return "\\a"
+        '\b' -> return "\\b"
+        '\f' -> return "\\f"
+        '\n' -> return "\\n"
+        '\r' -> return "\\r"
+        '\t' -> return "\\t"
+        '\v' -> return "\\v"
+        _ -> return $ if ' ' <= c && c <= '~'
+            then [c]
+            else "\\x" ++ showHex (ord c) ""
+    put $ Just c'
+    return c'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

@@ -0,0 +1,120 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Language.Cpp.SyntaxToken (
+      Identifier
+    , Code
+    , SyntaxToken(..)
+    , Directive(..)
+    , Punctuation
+    , punc
+    , unpunc
+    , puncs
+    , Keyword
+    , kw
+    , unkw
+    , keywords
+    ) where
+
+
+import Data.Char
+import Data.List
+import Numeric
+
+
+type Identifier = String
+type Code = String
+
+
+data SyntaxToken a
+    = String String
+    | Char Char
+    | Integer Integer
+    | Floating Rational
+    | Identifier Identifier
+    | Directive Directive
+    | Punctuation Punctuation
+    | Keyword Keyword
+    | Comment
+    | Ext a
+    deriving (Show, Eq, Ord)
+
+
+instance Functor SyntaxToken where
+    fmap func tok = case tok of
+        String s -> String s
+        Char c -> Char c
+        Integer n -> Integer n
+        Floating f -> Floating f
+        Identifier i -> Identifier i
+        Directive d -> Directive d
+        Punctuation p -> Punctuation p
+        Keyword k -> Keyword k
+        Comment -> Comment
+        Ext x -> Ext (func x)
+
+
+data Directive
+    = Include FilePath
+    | Define Identifier (Maybe [Identifier]) Code
+    | If Code
+    | Ifdef Code
+    | Ifndef Code
+    | Endif
+    deriving (Show, Eq, Ord)
+
+
+newtype Punctuation = Punc String
+    deriving (Show, Eq, Ord)
+
+
+punc :: String -> Punctuation
+punc = Punc
+
+
+unpunc :: Punctuation -> String
+unpunc (Punc s) = s
+
+
+puncs :: [Punctuation]
+puncs = map punc $ [
+  "{", "}", "[", "]", "(", ")", "<", ">", "<=", ">=",
+  "+", "-", "*", "/", "~", "!", "%", "^", "&", "|",
+  "<<", ">>", "++", "--",
+  "&&", "||", "==", "!=",
+  ".", "->", ".*", "->*",
+  "=", "+=", "-=", "*=", "/=", "%=", "<<=", ">>=", "&=", "^=", "|=",
+  "?", ":", ",", ";", "::",
+  "#", "##",
+  "\\"
+  ]
+
+
+newtype Keyword = Kw String
+    deriving (Show, Eq, Ord)
+
+
+kw :: String -> Keyword
+kw = Kw
+
+
+unkw :: Keyword -> String
+unkw (Kw s) = s
+
+
+keywords :: [Keyword]
+keywords = map kw $ words $ "alignas alignof and and_eq asm auto bitand bitor bool break case catch char char16_t"
+    ++ " char32_t class compl const constexpr const_cast continue decltype default delete do double dynamic_cast"
+    ++ " else enum explicit export extern false float for friend goto if inline int long mutable namespace new"
+    ++ " noexcept not not_eq nullptr operator or or_eq private protected public register reinterpret_cast"
+    ++ " return short signed sizeof static static_assert static_cast struct switch template this thread_local"
+    ++ " throw true try typedef typeid typename union unsigned using virtual void volatile wchar_t while xor"
+    ++ " xor_eq"
+
+
+
+
+
+
+
+
+