cimple 0.0.16 → 0.0.17

raw patch · 7 files changed

+93/−65 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cimple.cabal +1/−1
• src/Language/Cimple/Flatten.hs +28/−2
• src/Language/Cimple/IO.hs +14/−16
• src/Language/Cimple/Lexer.x +15/−15
• src/Language/Cimple/Parser.y +22/−19
• src/Language/Cimple/SemCheck/Includes.hs +4/−1
• tools/dump-tokens.hs +9/−11

@@ -1,5 +1,5 @@ name:                 cimple-version:              0.0.16+version:              0.0.17 synopsis:             Simple C-like programming language homepage:             https://toktok.github.io/ license:              GPL-3

@@ -10,7 +10,7 @@ import           Data.Fix            (Fix (..)) import           Data.Maybe          (maybeToList) import           GHC.Generics-import           Language.Cimple.Ast (AssignOp, BinaryOp, CommentF,+import           Language.Cimple.Ast (AssignOp, BinaryOp, CommentF (..),                                       CommentStyle, LiteralType, NodeF (..),                                       Scope, UnaryOp) @@ -56,7 +56,33 @@     gconcatsFlatten = concatMap gconcatsFlatten  instance GenConcatsFlatten (Fix (CommentF a)) a where-    gconcatsFlatten = error "TODO: gconcatsFlatten for CommentF"+    -- TODO(iphydf): Figure out how to write this using Generics.+    gconcatsFlatten (Fix DocNewline) = []+    gconcatsFlatten (Fix DocPrivate) = []+    gconcatsFlatten (Fix (DocAssignOp _ l r)) = concatMap gconcatsFlatten [l, r]+    gconcatsFlatten (Fix (DocAttention x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocBinaryOp _ l r)) = concatMap gconcatsFlatten [l, r]+    gconcatsFlatten (Fix (DocBrief x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocColon x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocComment x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocDeprecated x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocExtends x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocImplements x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocLine x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocList x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocLParen x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocOLItem i x)) = i : gconcatsFlatten x+    gconcatsFlatten (Fix (DocParagraph x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocParam a p x)) = concat [gconcatsFlatten a, gconcatsFlatten p, gconcatsFlatten x]+    gconcatsFlatten (Fix (DocP x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocRef x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocReturn x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocRetval r x)) = r : gconcatsFlatten x+    gconcatsFlatten (Fix (DocRParen x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocSee r x)) = r : gconcatsFlatten x+    gconcatsFlatten (Fix (DocSentence x p)) = gconcatsFlatten x ++ [p]+    gconcatsFlatten (Fix (DocULItem i x)) = concat [gconcatsFlatten i, gconcatsFlatten x]+    gconcatsFlatten (Fix (DocWord x)) = [x]  instance GenConcatsFlatten t a => GenConcats (Rec0 t) a where     gconcats (K1 x) = gconcatsFlatten x

@@ -10,11 +10,10 @@ import           Control.Monad                   ((>=>)) import qualified Control.Monad.Parallel          as P import           Control.Monad.State.Strict      (State, evalState, get, put)-import qualified Data.ByteString                 as BS+import qualified Data.ByteString.Lazy            as LBS import           Data.Map.Strict                 (Map) import qualified Data.Map.Strict                 as Map import           Data.Text                       (Text)-import qualified Data.Text                       as Text import qualified Data.Text.Encoding              as Text import           Language.Cimple.Ast             (Node) import           Language.Cimple.Lexer           (Lexeme, runAlex)@@ -27,37 +26,36 @@ import           Language.Cimple.TranslationUnit (TranslationUnit) import qualified Language.Cimple.TreeParser      as TreeParser -type StringNode = Node (Lexeme String) type TextNode = Node (Lexeme Text) -toTextAst :: [StringNode] -> [TextNode]-toTextAst stringAst =-    evalState (mapAst cacheActions stringAst) Map.empty+cacheText :: [TextNode] -> [TextNode]+cacheText textAst =+    evalState (mapAst cacheActions textAst) Map.empty   where-    cacheActions :: TextActions (State (Map String Text)) String Text+    cacheActions :: TextActions (State (Map Text Text)) Text Text     cacheActions = textActions $ \s -> do         m <- get         case Map.lookup s m of             Nothing -> do-                let text = Text.pack s-                put $ Map.insert s text m-                return text+                put $ Map.insert s s m+                return s             Just text ->                 return text   parseText :: Text -> Either String [TextNode]-parseText contents =-    toTextAst <$> runAlex (Text.unpack contents) Parser.parseTranslationUnit+parseText = fmap cacheText . flip runAlex Parser.parseTranslationUnit . LBS.fromStrict . Text.encodeUtf8 -parseTextPedantic :: Text -> Either String [TextNode]-parseTextPedantic =-    parseText >=> ParseResult.toEither . TreeParser.parseTranslationUnit+parseBytes :: LBS.ByteString -> Either String [TextNode]+parseBytes = flip runAlex Parser.parseTranslationUnit +parseBytesPedantic :: LBS.ByteString -> Either String [TextNode]+parseBytesPedantic = parseBytes >=> ParseResult.toEither . TreeParser.parseTranslationUnit + parseFile :: FilePath -> IO (Either String (TranslationUnit Text)) parseFile source =-    addSource . parseTextPedantic . Text.decodeUtf8 <$> BS.readFile source+    addSource . parseBytesPedantic <$> LBS.readFile source   where     -- Add source filename to the error message, if any.     addSource (Left err) = Left $ source <> err

@@ -4,6 +4,7 @@ {-# LANGUAGE DeriveTraversable  #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StrictData         #-}+{-# OPTIONS_GHC -Wno-unused-imports #-} module Language.Cimple.Lexer     ( Alex     , AlexPosn (..)@@ -15,16 +16,20 @@     , lexemePosn     , lexemeText     , lexemeLine-    , mkL     , runAlex     ) where  import           Data.Aeson             (FromJSON, ToJSON)+import qualified Data.ByteString        as BS+import qualified Data.ByteString.Lazy   as LBS+import           Data.Text              (Text)+import qualified Data.Text              as Text+import qualified Data.Text.Encoding     as Text import           GHC.Generics           (Generic) import           Language.Cimple.Tokens (LexemeClass (..)) } -%wrapper "monad"+%wrapper "monad-bytestring"  tokens :- @@ -186,7 +191,7 @@ <0,ppSC>	[a-z][a-z0-9_]*_cb			{ mkL IdFuncType } <0,ppSC>	[a-z][A-Za-z0-9_]*			{ mkL IdVar } <0,ppSC,cmtSC>	[0-9]+[LU]*				{ mkL LitInteger }-<0,ppSC,cmtSC>	[0-9]+"."[0-9]+f?			{ mkL LitInteger }+<0,ppSC,cmtSC>	[0-9]+"."[0-9]+[Ff]?			{ mkL LitInteger } <0,ppSC>	0x[0-9a-fA-F]+[LU]*			{ mkL LitInteger } <0,ppSC,cmtSC>	"="					{ mkL PctEq } <0,ppSC,cmtSC>	"=="					{ mkL PctEqEq }@@ -291,19 +296,19 @@ <0,ppSC,cmtSC,codeSC>	.				{ mkL ErrorToken }  {-deriving instance Ord AlexPosn deriving instance Generic AlexPosn instance FromJSON AlexPosn instance ToJSON AlexPosn  data Lexeme text = L AlexPosn LexemeClass text-    deriving (Ord, Eq, Show, Generic, Functor, Foldable, Traversable)+    deriving (Eq, Show, Generic, Functor, Foldable, Traversable)  instance FromJSON text => FromJSON (Lexeme text) instance ToJSON text => ToJSON (Lexeme text) -mkL :: Applicative m => LexemeClass -> AlexInput -> Int -> m (Lexeme String)-mkL c (p, _, _, str) len = pure $ L p c (take len str)+mkL :: LexemeClass -> AlexInput -> Int64 -> Alex (Lexeme Text)+mkL c (p, _, str, _) len = pure $ L p c (piece str)+  where piece = Text.decodeUtf8 . LBS.toStrict . LBS.take len  lexemePosn :: Lexeme text -> AlexPosn lexemePosn (L p _ _) = p@@ -317,15 +322,10 @@ lexemeLine :: Lexeme text -> Int lexemeLine (L (AlexPn _ l _) _ _) = l -start :: Int -> AlexInput -> Int -> Alex (Lexeme String)-start code _ _ = do-    alexSetStartCode code-    alexMonadScan--alexEOF :: Alex (Lexeme String)-alexEOF = return (L (AlexPn 0 0 0) Eof "")+alexEOF :: Alex (Lexeme Text)+alexEOF = return (L (AlexPn 0 0 0) Eof Text.empty) -alexScanTokens :: String -> Either String [Lexeme String]+alexScanTokens :: LBS.ByteString -> Either String [Lexeme Text] alexScanTokens str =     runAlex str $ loop []   where

@@ -1,9 +1,12 @@ {+{-# LANGUAGE OverloadedStrings #-} module Language.Cimple.Parser     ( parseTranslationUnit     ) where  import           Data.Fix               (Fix (..))+import           Data.Text              (Text)+import qualified Data.Text              as Text import           Language.Cimple.Ast    (AssignOp (..), BinaryOp (..),                                          CommentStyle (..), LiteralType (..),                                          Node, NodeF (..), Scope (..),@@ -22,7 +25,7 @@ %errorhandlertype explist %lexer {lexwrap} {L _ Eof _} %monad {Alex}-%tokentype {StringLexeme}+%tokentype {Term} %token     ID_CONST			{ L _ IdConst			_ }     ID_FUNC_TYPE		{ L _ IdFuncType		_ }@@ -173,12 +176,12 @@ CopyrightDecl :	' ' 'Copyright' CopyrightDates CopyrightOwner '\n'	{ Fix $ CopyrightDecl (fst $3) (snd $3) $4 } -CopyrightDates :: { (StringLexeme, Maybe StringLexeme) }+CopyrightDates :: { (Term, Maybe Term) } CopyrightDates :	LIT_INTEGER						{ ($1, Nothing) } |	LIT_INTEGER '-' LIT_INTEGER				{ ($1, Just $3) } -CopyrightOwner :: { [StringLexeme] }+CopyrightOwner :: { [Term] } CopyrightOwner :	CMT_WORD CommentWords					{ $1 : reverse $2 } @@ -216,24 +219,24 @@ |	'/** @} */'						{ Fix $ CommentSectionEnd $1 } |	Ignore							{ $1 } -CommentTokens :: { [StringLexeme] }+CommentTokens :: { [Term] } CommentTokens :	CommentToken						{ [$1] } |	CommentTokens CommentToken				{ $2 : $1 } -CommentToken :: { StringLexeme }+CommentToken :: { Term } CommentToken :	CommentWord						{ $1 } |	'\n'							{ $1 } |	' * '							{ $1 } |	' '							{ $1 } -CommentWords :: { [StringLexeme] }+CommentWords :: { [Term] } CommentWords :								{ [] } |	CommentWords CommentWord				{ $2 : $1 } -CommentWord :: { StringLexeme }+CommentWord :: { Term } CommentWord :	CMT_WORD						{ $1 } |	CMT_COMMAND						{ $1 }@@ -265,7 +268,7 @@ Ignore :	IGN_START IgnoreBody IGN_END				{ Fix $ Comment Ignore $1 (reverse $2) $3 } -IgnoreBody :: { [StringLexeme] }+IgnoreBody :: { [Term] } IgnoreBody :	IGN_BODY						{ [$1] } |	IgnoreBody IGN_BODY					{ $2 : $1 }@@ -344,7 +347,7 @@ Stmt :	PreprocIfdef(Stmts)					{ $1 } |	PreprocIf(Stmts)					{ $1 }-|	PreprocDefine Stmts PreprocUndef			{ Fix $ PreprocScopedDefine $1 $2 $3 }+|	PreprocDefine Stmts PreprocUndef			{ Fix $ PreprocScopedDefine $1 (reverse $2) $3 } |	DeclStmt						{ $1 } |	CompoundStmt						{ $1 } |	IfStmt							{ $1 }@@ -602,7 +605,7 @@ |	EnumeratorName '=' ConstExpr ','			{ Fix $ Enumerator $1 (Just $3) } |	Comment							{ $1 } -EnumeratorName :: { StringLexeme }+EnumeratorName :: { Term } EnumeratorName :	ID_CONST						{ $1 } |	ID_SUE_TYPE						{ $1 }@@ -683,11 +686,11 @@ |	nullable '(' Ints ')'					{ Fix . NonNull [] $3 } |	non_null '(' Ints ')' nullable '(' Ints ')'		{ Fix . NonNull $3 $7 } -Ints :: { [StringLexeme] }+Ints :: { [Term] } Ints :	IntList							{ reverse $1 } -IntList :: { [StringLexeme] }+IntList :: { [Term] } IntList :	LIT_INTEGER						{ [$1] } |	IntList ',' LIT_INTEGER					{ $3 : $1 }@@ -729,8 +732,8 @@ |	static const LeafType ID_VAR '=' InitialiserExpr ';'	{ Fix $ ConstDefn Static $3 $4 $6 }  {-type StringLexeme = Lexeme String-type NonTerm = Node StringLexeme+type Term = Lexeme Text+type NonTerm = Node Term  tyPointer, tyConst :: NonTerm -> NonTerm tyPointer = Fix . TyPointer@@ -741,14 +744,14 @@     alexError $ ":" <> show line <> ":" <> show col <> ": Parse error near " <> show c <> ": "         <> show t <> "; expected one of " <> show options -lexwrap :: (Lexeme String -> Alex a) -> Alex a+lexwrap :: (Lexeme Text -> Alex a) -> Alex a lexwrap = (alexMonadScan >>=)  externC-    :: Lexeme String-    -> Lexeme String+    :: Term+    -> Term     -> [NonTerm]-    -> Lexeme String+    -> Term     -> Alex NonTerm externC (L _ _ "__cplusplus") (L _ _ "\"C\"") decls (L _ _ "__cplusplus") =     return $ Fix $ ExternC decls@@ -758,7 +761,7 @@  macroBodyStmt     :: NonTerm-    -> Lexeme String+    -> Term     -> Alex NonTerm macroBodyStmt decls (L _ _ "0") =     return $ Fix $ MacroBodyStmt decls

@@ -8,6 +8,7 @@ import           Control.Monad.State.Strict      (State) import qualified Control.Monad.State.Strict      as State import           Data.Fix                        (Fix (..))+import           Data.List                       (isInfixOf) import           Data.Text                       (Text) import qualified Data.Text                       as Text import           Language.Cimple.Ast             (NodeF (..))@@ -25,9 +26,11 @@   -> [FilePath]   -> Either String ((), FilePath, [FilePath]) collectIncludes sources (file, _) includes =-    case filter (not . (`elem` sources)) includes of+    case filter (not . exempt) . filter (not . (`elem` sources)) $ includes of         []        -> Right ((), file, includes)         missing:_ -> Left $ file <> " includes missing " <> missing+  where+    exempt = ("/third_party/" `isInfixOf`)   relativeTo :: FilePath -> FilePath -> FilePath

@@ -1,23 +1,21 @@ module Main (main) where -import qualified Data.ByteString    as BS-import qualified Data.Text          as Text-import qualified Data.Text.Encoding as Text-import           Language.Cimple    (alexScanTokens)-import           System.Environment (getArgs)-import           Text.Groom         (groom)+import qualified Data.ByteString.Lazy as LBS+import           Language.Cimple      (alexScanTokens)+import           System.Environment   (getArgs)+import           Text.Groom           (groom)  processFile :: FilePath -> IO () processFile source = do     putStrLn $ "Processing " ++ source-    contents <- Text.unpack . Text.decodeUtf8 <$> BS.readFile source+    contents <- LBS.readFile source     case alexScanTokens contents of         Left err -> fail err         Right ok -> putStrLn $ groom ok  main :: IO () main = do-  args <- getArgs-  case args of-    [src] -> processFile src-    _     -> fail "Usage: dump-tokens <file.c>"+    args <- getArgs+    case args of+      [src] -> processFile src+      _     -> fail "Usage: dump-tokens <file.c>"