├── .ghci ├── .gitignore ├── C2Swift.hs ├── LICENSE ├── Language ├── Bracer.hs └── Bracer │ ├── Backends │ ├── C.hs │ ├── C │ │ ├── Parser.hs │ │ ├── Parser │ │ │ ├── Expressions.hs │ │ │ ├── Identifiers.hs │ │ │ ├── Internal.hs │ │ │ ├── Literals.hs │ │ │ ├── Statements.hs │ │ │ ├── Types.hs │ │ │ └── Variables.hs │ │ ├── Pretty.hs │ │ ├── Scribe.hs │ │ └── Syntax.hs │ ├── Swift.hs │ └── Swift │ │ ├── Predefined.hs │ │ └── Syntax.hs │ ├── Parsing.hs │ ├── Pretty.hs │ ├── Syntax.hs │ ├── Syntax │ ├── Lenses.hs │ ├── Names.hs │ └── Variables.hs │ ├── Test │ ├── C.hs │ ├── Examples │ │ └── BinaryLiterals.hs │ └── Internal.hs │ ├── Transformations.hs │ └── Transformations │ └── Failure.hs ├── Overture.hs ├── README.md ├── Setup.hs ├── Test.hs ├── bracer.cabal ├── docs └── c_declarations.md └── stack.yaml /.ghci: -------------------------------------------------------------------------------- 1 | :m + Data.Comp.Show 2 | :m + Control.Lens 3 | :m + Text.Trifecta 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .cabal-sandbox 3 | cabal.sandbox.config 4 | dist 5 | .hpc 6 | *.tix 7 | .stack-work 8 | -------------------------------------------------------------------------------- /C2Swift.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ViewPatterns #-} 2 | 3 | module Main where 4 | 5 | import Language.Bracer 6 | import qualified Language.Bracer.Backends.C as C 7 | import qualified Language.Bracer.Backends.C.Parser as CP 8 | import qualified Language.Bracer.Backends.Swift as Swift 9 | 10 | import Data.Comp 11 | 12 | translateBaseTypes :: CxtFun C.BaseType (Swift.Struct :+: Swift.TypeAlias :+: Swift.Tuple :+: Failure) 13 | translateBaseTypes (project -> Just C.Bool ) = deepInject Swift.bool 14 | translateBaseTypes (project -> Just C.Char ) = deepInject Swift.c_char 15 | translateBaseTypes (project -> Just C.Double ) = deepInject Swift.double 16 | translateBaseTypes (project -> Just C.Int ) = deepInject Swift.c_int 17 | translateBaseTypes (project -> Just C.Float ) = deepInject Swift.float 18 | translateBaseTypes (project -> Just C.Void ) = deepInject Swift.void 19 | translateBaseTypes (project -> Just C.Int128 ) = iUnsupportedFeature "Swift does not yet support 128-bit integers" 20 | translateBaseTypes (project -> Just (C.TypeOf _)) = iUnimplementedFeature "I have no idea how typeof() is gonna work" 21 | translateBaseTypes unmatched = iUnmatchedDatum 22 | 23 | main = print "hi" 24 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Patrick Thomson. 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. -------------------------------------------------------------------------------- /Language/Bracer.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer (module X) where 2 | 3 | import Language.Bracer.Syntax as X 4 | import Language.Bracer.Parsing as X 5 | import Language.Bracer.Transformations as X 6 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C 2 | (module X) where 3 | 4 | import Language.Bracer.Backends.C.Parser as X 5 | import Language.Bracer.Backends.C.Pretty as X 6 | import Language.Bracer.Backends.C.Syntax as X 7 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Parser.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C.Parser (module X) where 2 | 3 | import Language.Bracer.Backends.C.Parser.Internal as X 4 | import Language.Bracer.Backends.C.Parser.Expressions as X 5 | import Language.Bracer.Backends.C.Parser.Identifiers as X 6 | import Language.Bracer.Backends.C.Parser.Statements as X 7 | import Language.Bracer.Backends.C.Parser.Literals as X 8 | import Language.Bracer.Backends.C.Parser.Types as X 9 | import Language.Bracer.Backends.C.Parser.Variables as X 10 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Parser/Expressions.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C.Parser.Expressions where 2 | 3 | import Prelude () 4 | import Overture hiding (try) 5 | 6 | import Language.Bracer 7 | import Language.Bracer.Backends.C.Syntax as C 8 | import Language.Bracer.Backends.C.Parser.Internal 9 | import Language.Bracer.Backends.C.Parser.Types () 10 | 11 | import qualified Text.Parser.Expression as E 12 | import Text.Trifecta 13 | 14 | reserved = reserve identifierStyle 15 | 16 | instance ExpressionParsing CParser where 17 | -- Coproduct: expressions are either Literals, Idents, Exprs, or Operators 18 | type ExpressionSig CParser = Expr :+: Operator :+: TypeSig CParser 19 | 20 | parsePrefixOperator = choice 21 | [ iDec <$ (symbol "--" <* notFollowedBy (symbol "-")) 22 | , iInc <$ (symbol "++" <* notFollowedBy (symbol "+")) 23 | , try $ iCast <$> parens (deepInject <$> parseTypeName) 24 | , iRef <$ symbol "&" 25 | , iDeref <$ symbol "*" 26 | , iPos <$ symbol "+" 27 | , iNeg <$ symbol "-" 28 | , iBitwise Neg <$ symbol "~" 29 | , iNot <$ symbol "!" 30 | , iSizeOf <$ reserved "sizeof" 31 | ] 32 | 33 | parsePostfixOperator = choice 34 | [ iIndex <$$> brackets (deepInject <$> parseExpression) 35 | , iCall <$$> parens (commaSep parseExpression) 36 | , parseAccessor 37 | , iUnary <$> (iPostInc <$ reserved "++") 38 | , iUnary <$> (iPostDec <$ reserved "--") 39 | ] where 40 | infixl 1 <$$> 41 | a <$$> b = (flip a) <$> b 42 | parseAccessor = do 43 | operator <- choice [ iDot <$ dot, iArrow <$ symbol "->" ] 44 | nam <- (deepInject <$> parseIdentifier) 45 | return (\x -> iAccess x operator nam) 46 | 47 | infixOperatorTable = [] 48 | 49 | type ExpressionT = Term (ExpressionSig CParser) 50 | 51 | parsePrimaryExpression :: CParser ExpressionT 52 | parsePrimaryExpression = choice 53 | [ deepInject <$> parseIdentifier 54 | , deepInject <$> parseLiteral 55 | , iParen <$> parens parseExpression 56 | ] 57 | 58 | parsePostfixExpression :: CParser ExpressionT 59 | parsePostfixExpression = do 60 | subject <- parsePrimaryExpression 61 | postfixes <- many parsePostfixOperator 62 | return $ foldl (>>>) id postfixes subject 63 | 64 | parsePrefixExpression :: CParser ExpressionT 65 | parsePrefixExpression = foldl (<<<) id <$> (many (iUnary <$> parsePrefixOperator)) <*> parsePostfixExpression 66 | 67 | parseInfixExpression :: CParser ExpressionT 68 | parseInfixExpression = E.buildExpressionParser infixOperatorTable parsePrefixExpression 69 | 70 | parseExpression :: CParser ExpressionT 71 | parseExpression = parseInfixExpression 72 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Parser/Identifiers.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C.Parser.Identifiers where 2 | 3 | import Prelude () 4 | import Overture 5 | 6 | import Language.Bracer 7 | import Language.Bracer.Backends.C.Syntax 8 | import Language.Bracer.Backends.C.Parser.Internal 9 | 10 | import Data.HashSet 11 | import Text.Trifecta 12 | import Text.Parser.Token.Style 13 | 14 | instance IdentifierParsing CParser where 15 | type IdentifierSig CParser = Ident 16 | identifierStyle = c99Idents 17 | parseIdentifier = iIdent <$> parseName "identifier" 18 | 19 | infixl 4 **> 20 | a **> b = reserve identifierStyle a *> b 21 | 22 | c99Idents :: TokenParsing m => IdentifierStyle m 23 | c99Idents = haskellIdents 24 | { _styleReserved = fromList 25 | [ "->" 26 | , "++" 27 | , "--" 28 | , "&" 29 | , "*" 30 | , "+" 31 | , "-" 32 | , "~" 33 | , "!" 34 | , "/" 35 | , "%" 36 | , "<<" 37 | , ">>" 38 | , "/" 39 | , "%" 40 | , "<<" 41 | , ">>" 42 | , "<" 43 | , ">" 44 | , "<=" 45 | , ">=" 46 | , "==" 47 | , "!=" 48 | , "^" 49 | , "|" 50 | , "&&" 51 | , "?" 52 | , ":" 53 | , ";" 54 | , "..." 55 | , "=" 56 | , "*=" 57 | , "/=" 58 | , "%=" 59 | , "+=" 60 | , "-=" 61 | , "<<=" 62 | , ">>=" 63 | , "&=" 64 | , "^=" 65 | , "|=" 66 | , "," 67 | , "#" 68 | , "##" 69 | , "[" 70 | , "]" 71 | , "?" 72 | , ":" 73 | , "?:" 74 | , "..." 75 | , "asm" 76 | , "auto" 77 | , "break" 78 | , "case" 79 | , "char" 80 | , "const" 81 | , "continue" 82 | , "default" 83 | , "do" 84 | , "double" 85 | , "else" 86 | , "enum" 87 | , "extern" 88 | , "float" 89 | , "for" 90 | , "goto" 91 | , "if" 92 | , "inline" 93 | , "int" 94 | , "long" 95 | , "register" 96 | , "restrict" 97 | , "return" 98 | , "short" 99 | , "signed" 100 | , "sizeof" 101 | , "static" 102 | , "struct" 103 | , "switch" 104 | , "typedef" 105 | , "union" 106 | , "unsigned" 107 | , "void" 108 | , "volatile" 109 | , "while" 110 | , "__asm" 111 | , "__attribute__" 112 | , "__inline" 113 | , "__inline__" 114 | , "__typeof__" 115 | , "__builtin_va_arg" 116 | , "__builtin_offsetof" 117 | , "__int128_t" 118 | , "__uint128_t" 119 | ] 120 | } -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Parser/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | 3 | module Language.Bracer.Backends.C.Parser.Internal where 4 | 5 | import Prelude () 6 | import Overture hiding (try) 7 | 8 | import Language.Bracer.Syntax.Names 9 | 10 | import Control.Monad.State 11 | import Data.Default 12 | import Data.HashMap.Lazy (HashMap) 13 | import Text.Trifecta 14 | import Text.Parser.Token.Style 15 | 16 | newtype CParser a = CParser (StateT Environment Parser a) 17 | deriving ( Functor 18 | , Applicative 19 | , Alternative 20 | , Monad 21 | , MonadPlus 22 | , CharParsing 23 | , DeltaParsing 24 | , MonadState Environment 25 | ) 26 | deriving instance Parsing CParser 27 | 28 | data Environment = Environment 29 | { _typedefTable :: forall f . HashMap Name (Term f) 30 | } 31 | 32 | instance Default Environment where 33 | def = Environment mempty 34 | 35 | unCParser :: CParser a -> Parser a 36 | unCParser (CParser p) = evalStateT p def 37 | 38 | runCParser :: CParser a -> String -> Result a 39 | runCParser p = parseString (unCParser (whiteSpace *> p <* eof)) mempty 40 | 41 | testCParser :: (Show a) => CParser a -> String -> IO () 42 | testCParser p = parseTest (unCParser (whiteSpace *> p <* eof)) 43 | 44 | instance TokenParsing CParser where 45 | someSpace = buildSomeSpaceParser (CParser someSpace) javaCommentStyle 46 | 47 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Parser/Literals.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C.Parser.Literals where 2 | 3 | import Overture hiding (try) 4 | 5 | import Language.Bracer 6 | import Language.Bracer.Backends.C.Parser.Internal 7 | import Language.Bracer.Backends.C.Syntax 8 | 9 | import Text.Trifecta 10 | 11 | fractionalConstant :: CParser String 12 | fractionalConstant = do 13 | leading <- many digit 14 | void $ char '.' 15 | trailing <- 16 | if null leading 17 | then some digit 18 | else many digit 19 | return (leading ++ ('.' : trailing)) 20 | 21 | naturalExp :: CParser (Term (LiteralSig CParser)) 22 | naturalExp = do 23 | leading <- some digit 24 | expo <- exponentPart 25 | suff <- deepInject <$> floatingSuffix 26 | return $ iFltLit (read (leading ++ expo)) suff 27 | 28 | exponentPart :: CParser String 29 | exponentPart = do 30 | void $ oneOf "eE" 31 | sign <- optional (oneOf "+-") 32 | let sign' = fromMaybe '+' sign 33 | rest <- some digit 34 | return ('e' : sign' : rest) "exponent part" 35 | 36 | floatingSuffix :: CParser (Term Suffix) 37 | floatingSuffix = f <|> l <|> pure iNoSuffix "floating-point suffix" 38 | where 39 | f = iFloatSuffix <$> (oneOf "fF" *> floatingSuffix) 40 | l = iLongSuffix <$> (oneOf "lL" *> floatingSuffix) 41 | 42 | -- TODO: this is slightly more lenient than the real grammar but who cares 43 | integerSuffix :: CParser (Term Suffix) 44 | integerSuffix = u <|> l <|> pure iNoSuffix "integer suffix" 45 | where 46 | u = iUnsignedSuffix <$> (oneOf "uU" *> integerSuffix) 47 | l = iLongSuffix <$> (oneOf "lL" *> integerSuffix) 48 | 49 | floating :: CParser (Term (LiteralSig CParser)) 50 | floating = do 51 | fract <- fractionalConstant 52 | expo <- fromMaybe [] <$> optional exponentPart 53 | suff <- deepInject <$> floatingSuffix 54 | return (iFltLit (read (fract ++ expo)) suff) 55 | 56 | instance LiteralParsing CParser where 57 | type LiteralSig CParser = Literal :+: Suffix 58 | parseLiteral = choice 59 | [ try floating "floating-point constant" 60 | , try naturalExp 61 | , iIntLit <$> natural <*> (deepInject <$> integerSuffix) "integer" 62 | , iChrLit <$> charLiteral "character" 63 | , iStrLit <$> stringLiteral "string literal" 64 | ] 65 | 66 | type LiteralT = Term (LiteralSig CParser) -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Parser/Statements.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C.Parser.Statements where 2 | 3 | import Prelude () 4 | import Overture 5 | 6 | import Data.Vector 7 | import Language.Bracer 8 | import Language.Bracer.Backends.C.Syntax as C 9 | import Language.Bracer.Backends.C.Parser.Identifiers 10 | import Language.Bracer.Backends.C.Parser.Internal 11 | import Language.Bracer.Backends.C.Parser.Expressions 12 | import Language.Bracer.Backends.C.Parser.Variables () 13 | import Text.Trifecta 14 | import Language.Bracer.Backends.C.Parser.Types () 15 | 16 | blockItem :: CParser (Term (StatementSig CParser)) 17 | blockItem = choice [deepInject <$> parseStatement, deepInject <$> parseVariable] 18 | 19 | instance StatementParsing CParser where 20 | type StatementSig CParser = Statement :+: VariableSig CParser 21 | 22 | parseBlock = iBlock <$> (fromList <$> many parseStatement) 23 | 24 | parseStatement = choice 25 | [ C.iBreak <$ reserved "break;" 26 | , C.iCase <$> ("case" **> parseExp) <*> (colon *> parseStatement) 27 | , C.iContinue <$ reserved "continue;" 28 | , C.iCompound <$> braces (fromList <$> many blockItem) 29 | , C.iDefault <$> ("default" **> colon *> parseStatement) 30 | , C.iFor <$> ("for" **> parens parseBlock) <*> parseStatement 31 | , C.iGoto <$> ("goto" **> (deepInject <$> parseIdentifier) <* semi) 32 | , C.iIfThenElse <$> ("if" **> parens parseExp) <*> parseStatement <*> optional (reserved "else" *> parseStatement) 33 | , C.iLabeled <$> parseName <*> (colon *> parseStatement) 34 | , C.iReturn <$> ("return" **> optional parseExp <* semi) 35 | , C.iSwitch <$> ("switch" **> parens parseExp) <*> parseStatement 36 | , C.iWhile <$> ("while" **> parens parseExp) <*> parseStatement 37 | , parseExp <* semi 38 | , C.iEmpty <$ semi 39 | ] where parseExp = deepInject <$> parseExpression 40 | 41 | type StatementT = Term (StatementSig CParser) 42 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Parser/Types.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C.Parser.Types where 2 | 3 | import Prelude () 4 | import Overture hiding (try) 5 | 6 | import Language.Bracer 7 | import Language.Bracer.Backends.C.Syntax as C 8 | import Language.Bracer.Backends.C.Parser.Internal 9 | import Language.Bracer.Backends.C.Parser.Identifiers () 10 | import Language.Bracer.Backends.C.Parser.Literals () 11 | 12 | import Control.Monad.State 13 | import qualified Data.HashMap.Lazy as M 14 | import Text.Trifecta 15 | 16 | instance TypeParsing CParser where 17 | type TypeSig CParser = 18 | BaseType 19 | :+: TypeModifier 20 | :+: Typedef 21 | :+: Variable 22 | :+: Function 23 | :+: IdentifierSig CParser 24 | :+: LiteralSig CParser 25 | 26 | parseTypeName = do 27 | specs <- parseSpecifierList 28 | ptrs <- (mconcat . reverse) <$> many parsePointer 29 | return $ appEndo ptrs specs 30 | 31 | type TypeT = Term (TypeSig CParser) 32 | 33 | -- | Parses 'BaseType' specifiers: any specifier that cannot modify other types, 34 | -- | like @void@, @char@, @int@, previously specified @typedef@s, and so on. 35 | -- | This is a subset of the C99 grammar for type specifiers. 36 | parseBaseType :: CParser TypeT 37 | parseBaseType = choice 38 | [ solo C.iVoid "void" 39 | , solo C.iChar "char" 40 | , solo C.iInt "int" 41 | , solo C.iInt128 "__int128_t" 42 | , solo C.iUInt128 "__uint128_t" 43 | , solo C.iFloat "float" 44 | , solo C.iDouble "double" 45 | , solo C.iBool "_Bool" 46 | , (try parseTypedef) "typedef" 47 | ] "type specifier" where solo fn n = fn <$ reserve identifierStyle n 48 | 49 | parseParameter :: CParser TypeT 50 | parseParameter = do 51 | preamble <- parseSpecifierList 52 | declarator <- parseDeclarator 53 | return $ appEndo declarator preamble 54 | 55 | -- | Attempts to parse a valid, previously-defined typedef. 56 | parseTypedef :: CParser TypeT 57 | parseTypedef = do 58 | (Ident nam) <- unTerm <$> parseIdentifier 59 | table <- gets _typedefTable 60 | case M.lookup nam table of 61 | Just val -> return $ deepInject <$> C._typedefChildType $ unTerm val 62 | Nothing -> fail ("typedef " <> show nam <> " not found") 63 | 64 | -- | Parses 'TypeModifier' specifiers: any storage-class specifier, type qualifier, or 65 | -- type specifier that can be applied to another type. If no type is specified, @int@ 66 | -- will be provided (e.g. @short@ is the same as @short int@). 67 | parseModifier :: CParser (Endo TypeT) 68 | parseModifier = choice 69 | [ endo typedef "typedef" 70 | , endo C.iExtern "extern" 71 | , endo C.iStatic "static" 72 | , endo C.iAuto "auto" 73 | , endo C.iRegister "register" 74 | , endo C.iShort "short" 75 | , endo C.iConst "const" 76 | , endo C.iRestrict "restrict" 77 | , endo C.iVolatile "volatile" 78 | , endo C.iInline "inline" 79 | , endo C.iLong "long" 80 | , endo C.iSigned "signed" 81 | , endo C.iUnsigned "unsigned" 82 | , endo C.iComplex "_Complex" 83 | ] "type qualifier" where 84 | typedef a = C.iTypedef a Anonymous 85 | endo fn n = Endo fn <$ reserve identifierStyle n 86 | 87 | -- | Parses a list of base types and modifiers and combines them into a single type. 88 | -- TODO: if multiple base types are passed (e.g. @long double double@) this will 89 | -- silently drop them on the floor. I can't figure out how to warn with Trifecta yet. 90 | parseSpecifierList :: CParser TypeT 91 | parseSpecifierList = do 92 | let parseTypeSpecifier = (Left <$> parseModifier) <|> (Right <$> parseBaseType) 93 | (modifiers, roots) <- partitionEithers <$> some parseTypeSpecifier 94 | let modifier = appEndo $ mconcat modifiers 95 | -- TODO: dropping multiple terminals on the floor 96 | let typ' = if null roots then C.iInt else head roots 97 | return $ modifier typ' 98 | 99 | -- | Parses a pointer, possibly qualified with a modifier such as @const@ or @volatile@. 100 | parsePointer :: CParser (Endo TypeT) 101 | parsePointer = do 102 | ptr <- Endo C.iPointer <$ (optional someSpace *> char '*' <* optional someSpace) 103 | quals <- many parseModifier 104 | let ordered = quals ++ [ptr] 105 | return $ mconcat ordered 106 | 107 | -- | Parses an argument list for a function type. 108 | parseFunctionAppendix :: CParser (Endo TypeT) 109 | parseFunctionAppendix = do 110 | funcs <- parens (parseParameter `sepBy` comma) 111 | return (Endo $ \x -> C.iFunction Anonymous x funcs) 112 | 113 | -- | Parses an array modifier with an optional length. 114 | parseArrayAppendix :: CParser (Endo TypeT) 115 | parseArrayAppendix = do 116 | let plit = deepInject <$> parseLiteral 117 | bracks <- brackets (optional plit) 118 | return $ Endo $ C.iArray bracks 119 | 120 | -- | Parses an optionally-named declarator. If a name is present, it will 121 | -- return a 'Variable', otherwise it will return a type. 122 | parseDeclarator :: CParser (Endo TypeT) 123 | parseDeclarator = do 124 | let parseOptName = parseName <|> pure Anonymous 125 | buildPointers <- foldMany parsePointer 126 | body <- (Left <$> parens parseDeclarator) <|> (Right <$> parseOptName) 127 | append <- foldMany (parseFunctionAppendix <|> parseArrayAppendix) 128 | return $ Endo $ case body of 129 | (Left dec) -> appEndo dec . append . buildPointers 130 | (Right n) -> iVariable n . append . buildPointers 131 | 132 | 133 | -- Helper function that runs an 'Endo'-returning parser then concatenates and unwraps the result. 134 | foldMany :: Alternative f => f (Endo a) -> f (a -> a) 135 | foldMany p = appEndo <$> mconcat <$> many p 136 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Parser/Variables.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C.Parser.Variables where 2 | 3 | import Prelude () 4 | import Overture 5 | 6 | import Language.Bracer 7 | import Language.Bracer.Syntax () 8 | import Language.Bracer.Backends.C.Syntax 9 | import Language.Bracer.Backends.C.Parser.Internal 10 | import Language.Bracer.Backends.C.Parser.Expressions 11 | import Language.Bracer.Backends.C.Parser.Types 12 | 13 | import Text.Trifecta 14 | 15 | instance VariableParsing CParser where 16 | type VariableSig CParser = Declaration :+: Definition :+: ExpressionSig CParser 17 | 18 | parseVariable = do 19 | preamble <- parseSpecifierList 20 | declarator <- parseDeclarator 21 | initializer <- optional (symbol "=" *> (deepInject <$> parseExpression)) 22 | void $ symbol ";" 23 | let var = deepInject $ appEndo declarator $ preamble 24 | return $ maybe (iVariableDecl var) (iVariableDefn var) initializer 25 | 26 | parseSizedVariable = do 27 | preamble <- parseSpecifierList 28 | declarator <- parseDeclarator 29 | siz <- optional (symbol ":" *> (deepInject <$> parseExpression)) 30 | void $ symbol ";" 31 | let var = deepInject $ appEndo declarator $ preamble 32 | return $ maybe (iVariableDecl var) (iSizedDecl var) siz 33 | 34 | type VariableT = Term (VariableSig CParser) 35 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Language.Bracer.Backends.C.Pretty where 4 | 5 | import Overture hiding (Const, (<$>), group) 6 | import Prelude () 7 | 8 | import Language.Bracer hiding (Const, Empty) 9 | import Language.Bracer.Pretty 10 | import Language.Bracer.Backends.C.Syntax 11 | 12 | import Data.ByteString hiding (foldl, group) 13 | import Data.ByteString.UTF8 (toString) 14 | import Data.Scientific 15 | 16 | instance Pretty ByteString where 17 | pretty = pretty . toString 18 | 19 | instance Pretty Scientific where 20 | pretty = pretty . formatScientific Fixed Nothing 21 | 22 | instance Pretty Name where 23 | pretty Anonymous = mempty 24 | pretty (Name n) = pretty n 25 | 26 | deriving instance Pretty (Ident a) 27 | 28 | instance PrettyAlg Literal where 29 | prettyA (IntLit i s) = pretty i <> s 30 | prettyA (FltLit f s) = pretty f <> s 31 | -- if anyone can think of a better way to ensure characters are escaped, let me know 32 | prettyA (ChrLit c) = pretty $ show c 33 | prettyA (StrLit s) = dquotes $ pretty s 34 | 35 | instance PrettyAlg Suffix where 36 | prettyA (LongSuffix s) = "l" <> s 37 | prettyA (UnsignedSuffix s) = "u" <> s 38 | prettyA (FloatSuffix s) = "f" <> s 39 | prettyA NoSuffix = mempty 40 | 41 | instance PrettyAlg BaseType where 42 | prettyA Bool = "_Bool" 43 | prettyA (Builtin n) = pretty n 44 | prettyA Char = "char" 45 | prettyA Double = "double" 46 | prettyA (Enum Anonymous) = "enum" 47 | prettyA (Enum n) = "enum" <+> pretty n 48 | prettyA Float = "float" 49 | prettyA Int = "int" 50 | prettyA Int128 = "int128_t" 51 | prettyA (Struct Anonymous) = "struct" 52 | prettyA (Struct n) = "struct" <+> pretty n 53 | prettyA (TypeOf t) = "typeof" <> parens t 54 | prettyA (Union Anonymous) = "union" 55 | prettyA (Union n) = "union" <+> pretty n 56 | prettyA Void = "void" 57 | 58 | instance PrettyAlg TypeModifier where 59 | -- this isn't right but it will do for now 60 | prettyA (Array s t) = t <> brackets (pretty s) 61 | prettyA (Auto t) = "auto" <+> t 62 | prettyA (Complex t) = "_Complex" <+> t 63 | prettyA (Const t) = "const" <+> t 64 | prettyA (Extern t) = "extern" <+> t 65 | prettyA (Inline t) = "inline" <+> t 66 | prettyA (Long t) = "long" <+> t 67 | prettyA (Pointer t) = t <> "*" 68 | prettyA (Register t) = "register" <+> t 69 | prettyA (Restrict t) = "restrict" <+> t 70 | prettyA (Signed t) = "signed" <+> t 71 | prettyA (Short t) = "short" <+> t 72 | prettyA (Static t) = "static" <+> t 73 | prettyA (Unsigned t) = "unsigned" <+> t 74 | prettyA (Volatile t) = "volatile" <+> t 75 | 76 | instance PrettyAlg Expr where 77 | prettyA e@(Binary {}) = e^.left <+> e^.operation <+> e^.right 78 | prettyA e@(Ternary {}) = e^.operation <+> "?" <+> e^.left <+> ":" <+> e^.right 79 | prettyA e@(Index {}) = e^.left <> brackets (e^.right) 80 | prettyA e@(Call {}) = e^.target <> tupled (e^.arguments) 81 | prettyA (Paren t) = parens t 82 | prettyA a = fold a 83 | 84 | instance PrettyAlg Statement where 85 | prettyA (Block a) = foldl (<$>) mempty a 86 | prettyA Break = "break;" 87 | prettyA (Case c s) = "case" <+> c <> colon <+> s 88 | prettyA Continue = "continue;" 89 | prettyA (Compound a) = "{" <$> foldl (<$>) mempty a <$> "}" 90 | prettyA (Default s) = "default:" <+> s 91 | prettyA Empty = ";" 92 | prettyA (For a s) = "for" <+> parens (group a) <+> s 93 | prettyA (Goto a) = "goto" <+> a <> semi 94 | prettyA (IfThenElse c a Nothing) = "if" <+> parens c <$> a 95 | prettyA (IfThenElse c a (Just b)) = "if" <+> parens c <$> a <$> "else" <+> b 96 | prettyA (Labeled n a) = pretty n <> colon <+> a 97 | prettyA (Return Nothing) = "return;" 98 | prettyA (Return (Just a)) = "return" <+> a <> semi 99 | prettyA (Switch c s) = "switch" <+> parens c <+> s 100 | prettyA (While c s) = "while" <+> parens c <+> s 101 | 102 | 103 | instance PrettyAlg Operator where 104 | prettyA Add = "+" 105 | prettyA Sub = "-" 106 | prettyA Mul = "*" 107 | prettyA Div = "-" 108 | prettyA Mod = "%" 109 | prettyA Inc = "++" 110 | 111 | prettyA Dec = "--" 112 | 113 | prettyA Equal = "==" 114 | prettyA NotEqual = "=" 115 | prettyA (Cast t) = parens t 116 | prettyA Dot = "." 117 | prettyA Arrow = "->" 118 | prettyA Not = "!" 119 | 120 | prettyA And = "&&" 121 | prettyA Or = "||" 122 | prettyA Xor = "^" 123 | 124 | prettyA Neg = "-" 125 | prettyA Pos = "+" 126 | prettyA LShift = "<<" 127 | prettyA RShift = ">>" 128 | prettyA SizeOf = "sizeof" 129 | 130 | prettyA Ref = "&" 131 | prettyA Deref = "*" 132 | 133 | prettyA PostInc = "++" 134 | prettyA PostDec = "--" 135 | prettyA (Bitwise And) = "&" 136 | prettyA (Bitwise Or) = "|" 137 | prettyA (Bitwise Neg) = "~" 138 | prettyA (Bitwise x) = error ("no bitwise version of " ++ show x) 139 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Scribe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Language.Bracer.Backends.C.Scribe where 4 | 5 | import Prelude () 6 | import Overture 7 | 8 | import Control.Monad.Writer 9 | 10 | import Control.Monad.Identity 11 | import Data.Vector (Vector) 12 | import qualified Data.Vector as V 13 | import Language.Bracer.Syntax 14 | import Language.Bracer.Backends.C.Syntax 15 | import Language.Bracer.Backends.C.Parser 16 | import Language.Bracer.Parsing 17 | 18 | -- GHC complains if you try to 19 | newtype Wrapper = W { unW :: (Term (StatementSig CParser)) } 20 | 21 | newtype Scribe a = Scribe { unScribe :: WriterT (Vector Wrapper) Identity a } 22 | deriving ( Functor 23 | , Applicative 24 | , Monad) 25 | 26 | instance MonadWriter (Vector Wrapper) Scribe where 27 | tell = Scribe . tell 28 | listen = Scribe . listen . unScribe 29 | pass = Scribe . pass . unScribe 30 | 31 | scribe :: Scribe a -> Vector (Term (StatementSig CParser)) 32 | scribe = fmap unW . execWriter . unScribe 33 | 34 | int :: StatementT 35 | int = iInt 36 | 37 | lit :: Integer -> StatementT 38 | lit i = iIntLit i iNoSuffix 39 | -- 40 | tell' t = tell $ V.singleton $ W t 41 | 42 | def :: StatementT -> Name -> StatementT -> Scribe () 43 | def t nam val = tell' $ iVariableDefn (iVariable nam t) val 44 | 45 | block :: Scribe () -> Scribe () 46 | block contents = do 47 | let c = scribe contents 48 | tell' $ iBlock c 49 | 50 | ret :: StatementT -> Scribe () 51 | ret t = tell' $ iReturn (Just t) 52 | 53 | sample :: Scribe () 54 | sample = block $ do 55 | def int "retval" (lit 0) 56 | ret (iIdent "retval") 57 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/C/Syntax.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.C.Syntax where 2 | 3 | -- This module is designed to be imported qualified 4 | -- e.g. import Language.Bracer.Syntax.Types as C 5 | 6 | import Prelude () 7 | import Overture hiding (Char, Bool, Float, Double) 8 | import qualified Overture as O 9 | 10 | import Language.Bracer.Syntax.Names 11 | import Language.Bracer.Syntax.Lenses 12 | 13 | import Data.ByteString (ByteString) 14 | import Data.Comp.Derive 15 | import Data.Scientific 16 | import Data.Vector 17 | 18 | data Literal a 19 | = IntLit { _integerValue :: Integer, _suffix :: a} 20 | | FltLit { _floatingValue :: Scientific, _suffix :: a} 21 | | ChrLit { _charValue :: O.Char } 22 | | StrLit { _stringValue :: ByteString } 23 | deriving (Show, Eq, Functor) 24 | 25 | data Suffix a 26 | = LongSuffix a 27 | | UnsignedSuffix a 28 | | FloatSuffix a 29 | | NoSuffix 30 | deriving (Show, Eq, Functor) 31 | 32 | newtype Ident a = Ident Name 33 | deriving (Show, Eq, Functor) 34 | 35 | data BaseType a 36 | = Bool 37 | | Builtin Name 38 | | Char 39 | | Double 40 | | Enum Name 41 | | Float 42 | | Int 43 | | Int128 44 | | Struct Name 45 | | TypeOf a 46 | | Union Name 47 | | Void 48 | -- should Typedef go in here? I can't decide 49 | deriving (Show, Eq, Functor) 50 | 51 | data TypeModifier a 52 | = Array (Maybe a) a 53 | | Auto a 54 | | Complex a 55 | | Const a 56 | | Extern a 57 | | Inline a 58 | | Long a 59 | | Pointer a 60 | | Register a 61 | | Restrict a 62 | | Short a 63 | | Signed a 64 | | Static a 65 | | Unsigned a 66 | | Volatile a 67 | deriving (Show, Eq, Functor) 68 | 69 | data Type a = Type 70 | { _typeContents :: a 71 | , _typeSize :: Maybe a 72 | , _typeAttributes :: [a] 73 | } deriving (Show, Eq, Functor) 74 | 75 | data Typedef a = Typedef 76 | { _typedefChildType :: a 77 | , _typedefName :: Name 78 | } deriving (Show, Eq, Functor) 79 | 80 | data Composite a = Composite 81 | { _compositeKind :: a 82 | , _compositeName :: Name 83 | , _compositeMembers :: [a] 84 | } deriving (Show, Eq, Functor) 85 | 86 | data Function a = Function 87 | { _functionName :: Name 88 | , _functionReturnType :: a 89 | , _functionParameters :: [a] 90 | } deriving (Show, Eq, Functor) 91 | 92 | data Declaration a 93 | = VariableDecl a 94 | | SizedDecl a a 95 | | FunctionDecl a 96 | | MultipleDecl [a] 97 | deriving (Show, Eq, Functor) 98 | 99 | data Definition a 100 | = VariableDefn a a 101 | | FunctionDefn a [a] 102 | deriving (Show, Eq, Functor) 103 | 104 | data Expr a 105 | = Unary 106 | { _operation :: a 107 | , _target :: a 108 | } 109 | | Binary 110 | { _left :: a 111 | , _operation :: a 112 | , _right :: a 113 | } 114 | | Ternary 115 | { _condition :: a 116 | , _whenClause :: a 117 | , _elseClause :: a 118 | } 119 | | Index 120 | { _target :: a 121 | , _subscript :: a 122 | } 123 | | Call 124 | { _target :: a 125 | , _arguments :: [a] 126 | } 127 | | Access 128 | { _target :: a 129 | , _operation :: a 130 | , _member :: a 131 | } 132 | | Paren 133 | { _target :: a 134 | } 135 | deriving (Show, Eq, Functor, Foldable) 136 | 137 | data Statement a 138 | = Block (Vector a) 139 | | Break 140 | | Case a a 141 | | Continue 142 | | Compound (Vector a) 143 | | Default a 144 | | Empty 145 | | For a a 146 | | Goto a 147 | | IfThenElse a a (Maybe a) 148 | | Labeled Name a 149 | | Return (Maybe a) 150 | | Switch a a 151 | | While a a 152 | deriving (Show, Eq, Functor) 153 | 154 | data Operator a 155 | = Add 156 | | Sub 157 | | Cast a 158 | | Dot 159 | | Arrow 160 | | Inc 161 | | Dec 162 | | PostInc 163 | | PostDec 164 | | Ref 165 | | RShift 166 | | LShift 167 | | Mul 168 | | Mod 169 | | Equal 170 | | NotEqual 171 | | And 172 | | Or 173 | | Xor 174 | | Div 175 | | Deref 176 | | Pos 177 | | Neg 178 | | Bitwise (Operator a) 179 | | SizeOf 180 | | Not 181 | deriving (Eq, Show, Functor, Foldable, Traversable) 182 | 183 | derive 184 | [ smartConstructors, makeShowF, makeEqF ] 185 | [ ''BaseType 186 | , ''TypeModifier 187 | , ''Type 188 | , ''Typedef 189 | , ''Composite 190 | , ''Declaration 191 | , ''Definition 192 | , ''Function 193 | , ''Statement 194 | , ''Operator 195 | , ''Literal 196 | , ''Expr 197 | , ''Ident 198 | , ''Suffix 199 | ] 200 | 201 | derive [ makeLenses ] [ ''Function, ''Composite, ''Expr, ''Literal ] 202 | derive [ makePrisms ] [ ''Ident, ''Statement ] 203 | 204 | instance HasName (Ident a) where 205 | name = _Ident 206 | 207 | instance HasName (Function a) where 208 | name = functionName 209 | 210 | instance HasName (Composite a) where 211 | name = compositeName 212 | 213 | iUInt128 :: (BaseType :<: f, TypeModifier :<: f) => Cxt h f a 214 | iUInt128 = iUnsigned iInt128 215 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/Swift.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.Swift (module X) where 2 | 3 | import Language.Bracer.Backends.Swift.Syntax as X 4 | import Language.Bracer.Backends.Swift.Predefined as X -------------------------------------------------------------------------------- /Language/Bracer/Backends/Swift/Predefined.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Language.Bracer.Backends.Swift.Predefined where 4 | 5 | import Prelude () 6 | import Language.Bracer.Backends.Swift.Syntax 7 | 8 | import Data.Comp 9 | 10 | int16 :: PTerm Struct 11 | int16 = iStruct "Int16" [] [] [] 12 | 13 | int32 :: PTerm Struct 14 | int32 = iStruct "Int32" [] [] [] 15 | 16 | int64 :: PTerm Struct 17 | int64 = iStruct "Int64" [] [] [] 18 | 19 | int :: PTerm Struct 20 | int = iStruct "Int" [] [] [] 21 | 22 | uint8 :: PTerm Struct 23 | uint8 = iStruct "UInt8" [] [] [] 24 | 25 | bool :: PTerm Struct 26 | bool = iStruct "Bool" [] [] [] 27 | 28 | c_char :: PTerm Struct 29 | c_char = iStruct "CChar" [] [] [] 30 | 31 | c_int :: PTerm (TypeAlias :+: Struct) 32 | c_int = iTypeAlias "CInt" (deepInject int32) 33 | 34 | c_short :: PTerm (TypeAlias :+: Struct) 35 | c_short = iTypeAlias "CShort" (deepInject int16) 36 | 37 | c_long :: PTerm (TypeAlias :+: Struct) 38 | c_long = iTypeAlias "CLong" (deepInject int) 39 | 40 | c_longlong :: PTerm (TypeAlias :+: Struct) 41 | c_longlong = iTypeAlias "CLongLong" (deepInject int64) 42 | 43 | double :: PTerm Struct 44 | double = iStruct "Double" [] [] [] 45 | 46 | float :: PTerm Struct 47 | float = iStruct "Float" [] [] [] 48 | 49 | void :: PTerm (TypeAlias :+: Tuple) 50 | void = iTypeAlias "void" (iTuple []) 51 | -------------------------------------------------------------------------------- /Language/Bracer/Backends/Swift/Syntax.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Backends.Swift.Syntax where 2 | 3 | import Prelude () 4 | import Overture hiding (Enum) 5 | 6 | import Language.Bracer.Syntax.Names 7 | import Data.Comp.Derive 8 | 9 | data Struct a = Struct 10 | { _structName :: Name 11 | , _structParameterizedTypes :: [a] 12 | , _structAdoptedProtocols :: [Protocol a] 13 | , _structMembers :: [a] 14 | } deriving (Show, Eq, Functor) 15 | 16 | data TypeAlias a = TypeAlias { _aliasName :: Name, _aliasType :: a } 17 | deriving (Show, Eq, Functor) 18 | 19 | newtype Tuple a = Tuple { _tupleMembers :: [a] } 20 | deriving (Show, Eq, Functor) 21 | 22 | data Protocol a = Protocol 23 | { _protocolName :: Name 24 | , _protocolInherited :: [Protocol a] 25 | , _protocolMembers :: [a] 26 | } deriving (Show, Eq, Functor) 27 | 28 | data Class a = Class 29 | { _className :: Name 30 | , _classParameterizedTypes :: [a] 31 | , _classSuperclass :: Maybe a 32 | , _classAdoptedProtocols :: [Protocol a] 33 | , _classMembers :: [a] 34 | } deriving (Show, Eq, Functor) 35 | 36 | data EnumCase a 37 | = Union { _caseName :: Name, _caseMembers :: [a] } 38 | | Raw { _caseName :: Name, _caseValue :: Maybe a } 39 | deriving (Show, Eq, Functor) 40 | 41 | data Enum a = Enum 42 | { _enumName :: Name 43 | , _enumParameterizedTypes :: [a] 44 | , _enumRawType :: Maybe a 45 | , _enumCases :: [EnumCase a] 46 | } deriving (Show, Eq, Functor) 47 | 48 | derive 49 | [ smartConstructors, makeShowF, makeEqF ] 50 | [ ''Struct 51 | , ''TypeAlias 52 | , ''Tuple 53 | , ''Protocol 54 | , ''Class 55 | , ''EnumCase 56 | , ''Enum 57 | ] 58 | -------------------------------------------------------------------------------- /Language/Bracer/Parsing.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Parsing 2 | ( LiteralParsing (..) 3 | , IdentifierParsing (..) 4 | , TypeParsing (..) 5 | , VariableParsing (..) 6 | , ExpressionParsing (..) 7 | , StatementParsing (..) 8 | ) where 9 | 10 | import Prelude () 11 | import Overture 12 | 13 | import Text.Parser.Token 14 | import qualified Text.Parser.Expression as E 15 | 16 | import Language.Bracer.Syntax.Names 17 | 18 | -- Class for parsers that understand literals 19 | class (TokenParsing m) => LiteralParsing m where 20 | type LiteralSig m :: * -> * 21 | parseLiteral :: m (Term (LiteralSig m)) 22 | 23 | class (TokenParsing m, Monad m) => IdentifierParsing m where 24 | type IdentifierSig m :: * -> * 25 | identifierStyle :: IdentifierStyle m 26 | parseIdentifier :: m (Term (IdentifierSig m)) 27 | parseName :: m Name 28 | parseName = Name <$> ident identifierStyle 29 | 30 | class (LiteralParsing m, LiteralSig m :<: TypeSig m, IdentifierParsing m, IdentifierSig m :<: TypeSig m) => TypeParsing m where 31 | type TypeSig m :: * -> * 32 | parseTypeName :: m (Term (TypeSig m)) 33 | 34 | -- Class for parsers that understand expressions. Note that we use a type family 35 | -- here so that parsers, when implementing this class, get to specify the type of parsed expressions 36 | class (TypeParsing m, TypeSig m :<: ExpressionSig m) => ExpressionParsing m where 37 | type ExpressionSig m :: * -> * 38 | parsePrefixOperator :: m (Term (ExpressionSig m)) 39 | 40 | parsePostfixOperator :: m (Term (ExpressionSig m) -> Term (ExpressionSig m)) 41 | infixOperatorTable :: E.OperatorTable m (Term (ExpressionSig m)) 42 | 43 | class (ExpressionParsing m, ExpressionSig m :<: VariableSig m) => VariableParsing m where 44 | type VariableSig m :: * -> * 45 | 46 | parseVariable :: m (Term (VariableSig m)) 47 | parseSizedVariable :: m (Term (VariableSig m)) 48 | 49 | class (VariableParsing m, VariableSig m :<: StatementSig m) => StatementParsing m where 50 | type StatementSig m :: * -> * 51 | parseStatement :: m (Term (StatementSig m)) 52 | parseBlock :: m (Term (StatementSig m)) 53 | -------------------------------------------------------------------------------- /Language/Bracer/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE UndecidableInstances #-} 2 | 3 | module Language.Bracer.Pretty 4 | ( module Text.PrettyPrint.ANSI.Leijen 5 | , PrettyAlg (..) 6 | , PrettyRAlg (..) 7 | , Pretty (..) 8 | ) where 9 | 10 | import Data.Comp 11 | import Data.Comp.Derive 12 | import Text.PrettyPrint.ANSI.Leijen hiding ((<>)) 13 | 14 | class (Functor f) => PrettyAlg f where 15 | prettyA :: Alg f Doc 16 | 17 | class (Functor f) => PrettyRAlg f where 18 | prettyR :: RAlg f Doc 19 | 20 | instance (Functor f, PrettyAlg f) => PrettyRAlg f where 21 | prettyR = prettyA . fmap snd 22 | 23 | instance (PrettyRAlg f) => Pretty (Term f) where 24 | pretty = para prettyR 25 | 26 | instance (Pretty (f a), Pretty (g a)) => Pretty ((f :+: g) a) where 27 | pretty = caseF pretty pretty 28 | 29 | liftSum ''PrettyAlg 30 | -------------------------------------------------------------------------------- /Language/Bracer/Syntax.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Syntax 2 | ( module X ) where 3 | 4 | import Language.Bracer.Syntax.Names as X 5 | import Language.Bracer.Syntax.Lenses as X 6 | import Language.Bracer.Syntax.Variables as X 7 | -------------------------------------------------------------------------------- /Language/Bracer/Syntax/Lenses.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Syntax.Lenses 2 | ( module Control.Lens 3 | , HasName (..) 4 | , HasType (..) 5 | ) where 6 | 7 | import Language.Bracer.Syntax.Names 8 | import Data.Comp 9 | import Control.Lens hiding (scribe) 10 | 11 | _sub :: (to :<: super, from :<: super) => Prism (super a) (super a) (from a) (to a) 12 | _sub = prism' inj proj 13 | 14 | _term :: (to :<: super, from :<: super) => Prism (Term super) (Term super) (from (Term super)) (to (Term super)) 15 | _term = prism' inject project 16 | 17 | _deep :: (Functor to, Traversable from, to :<: super, from :<: super) => 18 | Prism (Term super) (Term super) (Term from) (Term to) 19 | _deep = prism' deepInject deepProject 20 | 21 | class HasName a where 22 | name :: Lens' a Name 23 | 24 | class HasType f t where 25 | typ :: Lens' f t 26 | -------------------------------------------------------------------------------- /Language/Bracer/Syntax/Names.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Syntax.Names 2 | ( Name (..) 3 | , _Name 4 | ) where 5 | 6 | import Prelude () 7 | import Overture 8 | 9 | import Control.Lens 10 | import Data.Hashable 11 | 12 | import Data.ByteString (ByteString) 13 | 14 | data Name = Name ByteString | Anonymous 15 | deriving (Eq, Show) 16 | 17 | instance Hashable Name where 18 | hashWithSalt s (Name n) = hashWithSalt s n 19 | hashWithSalt s Anonymous = hashWithSalt s (hash ()) 20 | 21 | makePrisms ''Name 22 | 23 | instance IsString Name where 24 | fromString "" = Anonymous 25 | fromString st = Name (fromString st) -------------------------------------------------------------------------------- /Language/Bracer/Syntax/Variables.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Syntax.Variables where 2 | 3 | import Prelude () 4 | import Overture 5 | 6 | import Language.Bracer.Syntax.Names 7 | import Language.Bracer.Syntax.Lenses 8 | 9 | import Data.Comp.Derive 10 | 11 | data Variable a = Variable 12 | { _variableName :: Name 13 | , _variableType :: a 14 | } deriving (Functor) 15 | 16 | derive [ smartConstructors, makeLenses, makeShowF, makeEqF ] [ ''Variable ] 17 | 18 | instance HasName (Variable a) where 19 | name = variableName 20 | 21 | instance HasType (Variable a) a where 22 | typ = variableType -------------------------------------------------------------------------------- /Language/Bracer/Test/C.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} 2 | 3 | module Language.Bracer.Test.C (tests) where 4 | 5 | import Prelude () 6 | import Overture 7 | 8 | import Test.Hspec 9 | import Test.Hspec.QuickCheck 10 | import Test.QuickCheck hiding (Success, Result) 11 | import Test.QuickCheck.Property hiding (Result) 12 | 13 | import Control.Lens 14 | import Text.Trifecta 15 | import Data.Comp.Show 16 | import Data.Scientific 17 | import qualified Data.Vector as V 18 | 19 | import Language.Bracer 20 | import Language.Bracer.Pretty 21 | import Language.Bracer.Backends.C 22 | import Language.Bracer.Test.Internal 23 | import Text.PrettyPrint.ANSI.Leijen hiding ((<>)) 24 | 25 | roundTrip :: (Pretty a) => CParser a -> a -> Result a 26 | roundTrip p it = 27 | let asString = displayS (renderCompact (pretty it)) "" 28 | in runCParser p asString 29 | 30 | tests :: Spec 31 | tests = describe "C" $ do 32 | 33 | let testInt = iIntLit 1 iNoSuffix 34 | let testFlt = iFltLit 1.0 iNoSuffix 35 | let testFlt2 = iFltLit (127.8) (iFloatSuffix iNoSuffix) 36 | let testFlt3 = iFltLit (616.6e100) iNoSuffix 37 | let testFlt4 = iFltLit (100e-100) iNoSuffix 38 | let testChr = iChrLit 'c' 39 | 40 | describe "token parser" $ do 41 | it "ignores traditional comments" $ 42 | runCParser (whiteSpace *> parseLiteral <* eof) "/* comment */ 1" `shouldParseAs` testInt 43 | it "ignores C++ style comments" $ 44 | runCParser (whiteSpace *> parseLiteral <* eof) "1 // comment" `shouldParseAs` testInt 45 | 46 | describe "literal parser" $ do 47 | it "parses integers" $ 48 | runCParser (parseLiteral <* eof) "1" `shouldParseAs` testInt 49 | it "parses floats" $ 50 | runCParser (parseLiteral <* eof) "1.0" `shouldParseAs` testFlt 51 | it "parses characters" $ 52 | runCParser (parseLiteral <* eof) "'c'" `shouldParseAs` testChr 53 | 54 | it "parses floats with suffixes" $ 55 | runCParser (parseLiteral <* eof) "127.8f" `shouldParseAs` testFlt2 56 | 57 | it "parses floats with exponent parts" $ do 58 | runCParser (parseLiteral <* eof) "616.6e100" `shouldParseAs` testFlt3 59 | runCParser (parseLiteral <* eof) "616.6e+100" `shouldParseAs` testFlt3 60 | 61 | it "parses floats with negative exponent parts" $ do 62 | runCParser (parseLiteral <* eof) "100.0e-100" `shouldParseAs` testFlt4 63 | runCParser (parseLiteral <* eof) "100e-100" `shouldParseAs` testFlt4 64 | 65 | it "doesn't accept just a dot as a valid float" $ do 66 | (runCParser (parseLiteral <* eof) ".") `shouldSatisfy` has _Failure 67 | 68 | prop "parses any floating-point number" $ do 69 | (NonNegative (s :: Scientific)) <- arbitrary 70 | let res = runCParser (parseLiteral <* eof) (show s) 71 | shouldSucceed res 72 | 73 | -- Doesn't compile as of 2015/8/10 74 | -- prop "preserves floating-point numbers round trip" $ do 75 | -- (NonNegative (s :: Scientific)) <- arbitrary 76 | -- let res = runCParser (parseLiteral <* eof) (show s) ^? _Success 77 | -- property (res /= (iFltLit s iNoSuffix)) 78 | 79 | describe "identifier parser" $ do 80 | let parseIdentifier' = parseIdentifier :: CParser (Term Ident) 81 | 82 | it "succeeds on valid identifiers" $ do 83 | runCParser (parseIdentifier' <* eof) "hello" `shouldParseAs` iIdent "hello" 84 | it "fails on reserved words" $ do 85 | shouldn'tParse (runCParser (parseIdentifier' <* eof) "return") 86 | it "fails on invalid identifiers" $ do 87 | shouldn'tParse (runCParser (parseIdentifier' <* eof) "$$$$$") 88 | 89 | describe "type parser" $ do 90 | 91 | it "parses simple types" $ 92 | runCParser (parseTypeName <* eof) "int" `shouldParseAs` iInt 93 | 94 | it "parses types with an implicit int" $ do 95 | runCParser parseTypeName "long" `shouldParseAs` iLong iInt 96 | 97 | it "parses types with pointers" $ do 98 | runCParser parseTypeName "int **" `shouldParseAs` iPointer (iPointer iInt) 99 | 100 | it "parses types with qualified pointers" $ do 101 | runCParser parseTypeName "int * volatile" `shouldParseAs` iVolatile (iPointer iInt) 102 | 103 | it "parses types with qualified pointers and implicit int" $ do 104 | runCParser parseTypeName "long ** const" `shouldParseAs` iConst (iPointer (iPointer (iLong iInt))) 105 | 106 | it "parses types with multiple qualified pointers" $ do 107 | runCParser parseTypeName "int * const * volatile" `shouldParseAs` iVolatile (iPointer (iConst (iPointer iInt))) 108 | 109 | describe "expression parser" $ do 110 | it "parses bare literals" $ do 111 | (runCParser parseExpression "5") `shouldParseAs` iIntLit 5 iNoSuffix 112 | (runCParser parseExpression "'c'") `shouldParseAs` iChrLit 'c' 113 | 114 | it "parses parenthesized literals correctly" $ do 115 | (runCParser parseExpression "(10)") `shouldParseAs` iParen (iIntLit 10 iNoSuffix) 116 | 117 | it "parses identifiers" $ do 118 | runCParser parseExpression "foo" `shouldParseAs` iIdent "foo" 119 | 120 | it "parses simple prefix operators" $ do 121 | let notGuilty = iUnary iNot (iIdent "guilty") 122 | runCParser parseExpression "!guilty" `shouldParseAs` notGuilty 123 | runCParser parseExpression "!!guilty" `shouldParseAs` iUnary iNot notGuilty 124 | runCParser parseExpression "! guilty" `shouldParseAs` notGuilty 125 | 126 | it "parses preincrement rather than two posivate" $ do 127 | runCParser parseExpression "++x" `shouldParseAs` iUnary iInc (iIdent "x") 128 | 129 | it "doesn't parse more than two trailing plus signs" $ do 130 | runCParser (parseExpression <* eof) "+++x" `shouldSatisfy` isn't _Success 131 | runCParser (parseExpression <* eof) "++++x" `shouldSatisfy` isn't _Success 132 | 133 | it "parses mixing prefix and postfix correctly" $ do 134 | runCParser (parseExpression <* eof) "!blah[500]" `shouldParseAs` 135 | iUnary iNot (iIndex (iIdent "blah") (iIntLit 500 iNoSuffix)) 136 | runCParser (parseExpression <* eof) "!!something()" `shouldParseAs` 137 | iUnary iNot (iUnary iNot (iCall (iIdent "something") [])) 138 | runCParser (parseExpression <* eof) "*it++" `shouldParseAs` (iUnary iDeref (iUnary iPostInc (iIdent "it"))) 139 | 140 | 141 | describe "variable parser" $ do 142 | 143 | it "parses simple variables" $ do 144 | runCParser (parseVariable <* eof) "int x;" `shouldParseAs` iVariableDecl (iVariable "x" iInt) 145 | runCParser (parseVariable <* eof) "long letter;" `shouldParseAs` iVariableDecl (iVariable "letter" (iLong iInt)) 146 | 147 | it "parses `const int (* volatile bar)[64]` correctly" $ do 148 | runCParser (parseVariable <* eof) "const int (* volatile biggie)[64];" `shouldParseAs` 149 | iVariableDecl (iVariable "biggie" (iVolatile (iPointer (iArray (Just (iIntLit 64 iNoSuffix)) (iConst iInt))))) 150 | 151 | it "parses `int (*(*big_pun)(void))[3]` correctly" $ do 152 | runCParser (parseVariable <* eof) "int (*(*big_pun)(void ))[3];" `shouldParseAs` 153 | iVariableDecl (iVariable "big_pun" (iPointer (iFunction Anonymous (iPointer (iArray (Just (iIntLit 3 iNoSuffix)) iInt)) [iVariable Anonymous iVoid]))) 154 | 155 | it "parses `char (*(*x[3])())[5]` correctly" $ do 156 | runCParser (parseVariable <* eof) "char (*(*x[3])())[5];" `shouldParseAs` 157 | iVariableDecl (iVariable "x" (iArray (Just (iIntLit 3 iNoSuffix)) (iPointer (iFunction Anonymous (iPointer (iArray (Just (iIntLit 5 iNoSuffix)) iChar)) [])))) 158 | 159 | it "parses variables with pointers" $ do 160 | runCParser (parseVariable <* eof) "const int *bar;" `shouldParseAs` iVariableDecl (iVariable "bar" (iPointer (iConst iInt))) 161 | 162 | it "parses variables with pointers" $ do 163 | runCParser (parseVariable <* eof) "int foo = 1;" `shouldSatisfy` has _Success 164 | 165 | 166 | 167 | 168 | describe "statement parser" $ do 169 | it "parses bare expressions" $ do 170 | (runCParser parseStatement "1;") `shouldParseAs` iIntLit 1 iNoSuffix 171 | 172 | it "parses break statements" $ 173 | (runCParser parseStatement "break;") `shouldParseAs` iBreak 174 | 175 | it "parses returns with and without values" $ do 176 | (runCParser parseStatement "return;") `shouldParseAs` iReturn Nothing 177 | (runCParser parseStatement "return 'c';") `shouldParseAs` (iReturn (Just (iChrLit 'c'))) 178 | 179 | it "parses block items" $ do 180 | let p = runCParser parseBlock "return 1; return 2; return 3;" 181 | p `shouldSatisfy` has _Success 182 | let (Just (blk :: Statement StatementT)) = project $ p ^?! _Success 183 | blk `shouldSatisfy` has _Block 184 | let vec = blk ^. _Block & lengthOf each 185 | vec `shouldBe` 3 186 | 187 | describe "pretty-printing" $ do 188 | 189 | it "should correctly round-trip literals" $ do 190 | roundTrip parseLiteral testInt `shouldParseAs` testInt 191 | roundTrip parseLiteral testFlt2 `shouldParseAs` testFlt2 192 | roundTrip parseLiteral testChr `shouldParseAs` testChr 193 | -------------------------------------------------------------------------------- /Language/Bracer/Test/Examples/BinaryLiterals.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Language.Bracer.Test.Examples.BinaryLiterals where 4 | 5 | import Prelude () 6 | import Overture 7 | 8 | import Language.Bracer 9 | import Language.Bracer.Pretty hiding ((<$>), string) 10 | import Language.Bracer.Backends.C 11 | import Language.Bracer.Test.Internal 12 | 13 | import Control.Monad.State 14 | import Data.Comp 15 | import Data.Comp.Derive 16 | import Numeric.Lens 17 | import Text.Trifecta 18 | 19 | import Test.Hspec 20 | import Test.Hspec.QuickCheck 21 | import Test.QuickCheck hiding (Success, Result) 22 | import Test.QuickCheck.Property hiding (Result) 23 | 24 | newtype CParserBin a = CParserBin { unCParserBin :: CParser a } 25 | deriving ( Functor 26 | , Applicative 27 | , Alternative 28 | , Monad 29 | , MonadPlus 30 | , MonadState Environment 31 | , CharParsing 32 | , TokenParsing 33 | , DeltaParsing 34 | -- , IdentifierParsing 35 | -- , TypeParsing 36 | -- , ExpressionParsing 37 | -- , StatementParsing 38 | ) 39 | 40 | deriving instance Parsing CParserBin 41 | 42 | newtype BinaryLiteral a = BinaryLiteral Integer 43 | deriving (Show, Eq, Functor) 44 | 45 | derive [smartConstructors, makeShowF, makeEqF] [''BinaryLiteral] 46 | 47 | instance IdentifierParsing CParserBin where 48 | type IdentifierSig CParserBin = IdentifierSig CParser 49 | parseIdentifier = parseIdentifier 50 | 51 | instance LiteralParsing CParserBin where 52 | type LiteralSig CParserBin = LiteralSig CParser :+: BinaryLiteral 53 | parseLiteral = (parseBinary "binary literal") <|> (deepInject <$> (CParserBin parseLiteral)) 54 | where 55 | parseBinary = do 56 | void $ string "0b" 57 | bin <- some $ oneOf "01" 58 | return $ iBinaryLiteral $ (bin ^?! binary) 59 | 60 | instance TypeParsing CParserBin where 61 | type TypeSig CParserBin = TypeSig CParser :+: BinaryLiteral 62 | parseTypeName = deepInject <$> parseTypeName 63 | 64 | instance PrettyAlg BinaryLiteral where 65 | prettyA (BinaryLiteral a) = "0b" <> (pretty $ binary # a) 66 | 67 | runParserBin :: CParserBin a -> String -> Result a 68 | runParserBin p = parseString (unCParser fullParser) mempty where fullParser = unCParserBin (whiteSpace *> p <* eof) 69 | 70 | tests :: Spec 71 | tests = describe "C with binary literals" $ do 72 | 73 | let testBin = iBinaryLiteral 64 :: Term (LiteralSig CParserBin) 74 | let testInt = iIntLit 202 iNoSuffix :: Term (LiteralSig CParserBin) 75 | 76 | describe "binary literals" $ do 77 | it "should parse them" $ do 78 | runParserBin parseLiteral "0b1000000" `shouldParseAs` testBin 79 | 80 | it "should parse other integers too" $ 81 | runParserBin parseLiteral "202" `shouldParseAs` testInt 82 | -------------------------------------------------------------------------------- /Language/Bracer/Test/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} --todo fix this 2 | 3 | module Language.Bracer.Test.Internal 4 | ( shouldParseAs 5 | , shouldn'tParse 6 | , shouldSucceed 7 | , Arbitrary (..) 8 | ) 9 | where 10 | 11 | import Prelude () 12 | import Overture 13 | 14 | import Test.Hspec 15 | import Test.HUnit 16 | import Test.QuickCheck hiding (Result) 17 | 18 | import Control.Lens 19 | import Data.Comp.Show 20 | import Data.Scientific 21 | import Text.Trifecta 22 | 23 | shouldSucceed = return . has _Success 24 | 25 | infix 1 `shouldParseAs` 26 | shouldParseAs :: (ShowF a, EqF a, Functor a) => Result (Term a) -> Term a -> Assertion 27 | shouldParseAs res ref = res `shouldSatisfy` (fromMaybe False . fmap (eqF ref) . preview _Success) 28 | 29 | shouldn'tParse :: (ShowF a, EqF a, Functor a) => Result (Term a) -> Assertion 30 | shouldn'tParse res = res `shouldSatisfy` isn't _Success 31 | 32 | instance Arbitrary Scientific where 33 | arbitrary = fromFloatDigits <$> (arbitrary :: Gen Double) -------------------------------------------------------------------------------- /Language/Bracer/Transformations.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Transformations (module X) where 2 | 3 | import Language.Bracer.Transformations.Failure as X -------------------------------------------------------------------------------- /Language/Bracer/Transformations/Failure.hs: -------------------------------------------------------------------------------- 1 | module Language.Bracer.Transformations.Failure where 2 | 3 | import Prelude () 4 | import Overture 5 | 6 | import Data.Comp.Derive 7 | 8 | data Failure a 9 | = UnsupportedFeature { _failureReason :: String } 10 | | UnimplementedFeature { _failureReason :: String } 11 | | UnmatchedDatum 12 | deriving (Eq, Show, Functor) 13 | 14 | smartConstructors ''Failure 15 | -------------------------------------------------------------------------------- /Overture.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoImplicitPrelude #-} 2 | 3 | module Overture 4 | ( module X 5 | ) 6 | where 7 | 8 | -- Haskell 98 stuff is easier to get at through the Prelude 9 | -- than through the GHC-specific modules 10 | import Prelude as X ( Bounded (..) 11 | , Double 12 | , Enum (..) 13 | , Float 14 | , Floating (..) 15 | , Fractional (..) 16 | , Integral (..) 17 | , Integer 18 | , Num (..) 19 | , Real (..) 20 | , RealFloat (..) 21 | , RealFrac (..) 22 | , (^) 23 | , (^^) 24 | , ($) 25 | , ($!) 26 | , asTypeOf 27 | , const 28 | , error 29 | , even 30 | , fromIntegral 31 | , flip 32 | , gcd 33 | , lcm 34 | , realToFrac 35 | , subtract 36 | , odd 37 | , until 38 | , undefined 39 | ) 40 | 41 | -- The important components of the base package 42 | import Control.Applicative as X hiding (liftA) 43 | import Control.Category as X 44 | import Control.Exception as X 45 | import Control.Monad as X hiding ( forM 46 | , forM_ 47 | , mapM 48 | , mapM_ 49 | , msum 50 | , sequence 51 | , sequence_ 52 | ) 53 | import Control.Monad.Fix as X 54 | import Data.Bool as X 55 | import Data.Char as X 56 | import Data.Comp as X hiding ( Const ) 57 | import Data.Either as X 58 | import Data.Eq as X 59 | import Data.Foldable as X 60 | import Data.Function as X hiding ((.), id) 61 | import Data.Functor as X 62 | import Data.Int as X 63 | import Data.List as X hiding ( all 64 | , and 65 | , any 66 | , concat 67 | , concatMap 68 | , elem 69 | , find 70 | , foldl 71 | , foldl1 72 | , foldl' 73 | , foldr 74 | , foldr1 75 | , mapAccumL 76 | , mapAccumR 77 | , maximum 78 | , maximumBy 79 | , minimum 80 | , minimumBy 81 | , notElem 82 | , or 83 | , product 84 | , sum 85 | ) 86 | import Data.Maybe as X 87 | import Data.Monoid as X 88 | import Data.Ord as X 89 | import Data.Ratio as X 90 | import Data.String as X 91 | import Data.Traversable as X 92 | import Data.Tuple as X 93 | import Data.Word as X 94 | 95 | import GHC.Float as X ( roundTo ) 96 | 97 | -- System facilities 98 | import System.Environment as X 99 | import System.Exit as X 100 | import System.IO as X 101 | import System.IO.Error as X ( userError ) 102 | 103 | -- Read, Show, and printf 104 | import Text.Printf as X 105 | import Text.Read as X ( Read (..) 106 | , lex 107 | , read 108 | , reads 109 | , readParen 110 | ) 111 | import Text.Show as X 112 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | bracer 2 | ====== 3 | 4 | Bracer is a system for parsing, rewriting, and extending the capabilities of curly-brace languages such as C, Go, Javascript, and Swift. It is written in Haskell, piggybacking on top of Edward Kmett's [trifecta][trifecta] library and Patrick Bahr's [compdata][compdata] for creating and rewriting compositional data types. 5 | It is intended to be simple, powerful, and easy to extend, making tradeoffs for flexibility rather than strict language compliance. 6 | It is in very early alpha; only the C backend works right now. 7 | Pull requests are enthusiastically accepted. 8 | 9 | 10 | Infrequently Asked Questions 11 | ---------------------------- 12 | 13 | **What's interesting about Bracer?** 14 | 15 | Bracer is much more minimal and generalizable than existing analysis/rewriting infrastructures such as CIL. It uses a non-traditional syntax tree based on compositionality (using coproducts of functors) rather than monolithic inheritance. It uses the sum-of-products approach to solve the [expression problem][exprob], combined with a novel use of GHC's support for type families to provide extensible parser constructs. Rather than relying on OO-style concepts like visitors for tree traversals, it provides modular rewriting constructs: morphisms, structured recursion schemes, and tree and macro automata. 16 | 17 | **Why not use libclang for this?** 18 | 19 | Clang is, needless to say, a brilliant piece of infrastructure. However, it has some disadvantages: it is extremely monolithic, very C++ focused, and has a significant learning curve. 20 | 21 | 22 | [compdata]: http://hackage.haskell.org/package/compdata 23 | [trifecta]: http://hackage.haskell.org/package/trifecta 24 | [exprob]: http://en.wikipedia.org/wiki/Expression_problem 25 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude () 4 | import Overture 5 | 6 | import Test.Hspec 7 | import qualified Test.Hspec.Core as HC 8 | 9 | import Language.Bracer 10 | import Language.Bracer.Test.C as C 11 | import Language.Bracer.Test.Examples.BinaryLiterals as BL 12 | 13 | main = hspec $ do 14 | C.tests 15 | BL.tests 16 | -------------------------------------------------------------------------------- /bracer.cabal: -------------------------------------------------------------------------------- 1 | name: bracer 2 | version: 0.1.1.0 3 | synopsis: a rewriting system for curly-brace languages 4 | homepage: http://github.com/patrickt/bracer 5 | license: MIT 6 | license-file: LICENSE 7 | author: Patrick Thomson 8 | maintainer: patrick.william.thomson@gmail.com 9 | category: Language 10 | build-type: Simple 11 | cabal-version: >=1.10 12 | 13 | -- NOTE: PT: to enable code coverage add -fhpc to both targets 14 | -- then cabal run test, then hpc report test.tix 15 | 16 | library 17 | build-depends: base 18 | , ansi-wl-pprint 19 | , bytestring 20 | , compdata 21 | , hashable 22 | , data-default 23 | , lens 24 | , mtl 25 | , parsers 26 | , scientific 27 | , semigroups 28 | , trifecta 29 | , vector 30 | , unordered-containers 31 | , utf8-string 32 | 33 | default-language: Haskell2010 34 | 35 | default-extensions: ConstraintKinds 36 | , DeriveFunctor 37 | , DeriveFoldable 38 | , DeriveGeneric 39 | , DeriveTraversable 40 | , FlexibleContexts 41 | , FlexibleInstances 42 | , GeneralizedNewtypeDeriving 43 | , KindSignatures 44 | , MultiParamTypeClasses 45 | , QuasiQuotes 46 | , RankNTypes 47 | , StandaloneDeriving 48 | , TemplateHaskell 49 | , TypeFamilies 50 | , TypeOperators 51 | , UndecidableInstances 52 | 53 | exposed-modules: Language.Bracer 54 | , Language.Bracer.Parsing 55 | , Language.Bracer.Pretty 56 | , Language.Bracer.Syntax 57 | , Language.Bracer.Syntax.Names 58 | , Language.Bracer.Syntax.Lenses 59 | , Language.Bracer.Syntax.Variables 60 | , Language.Bracer.Backends.C 61 | , Language.Bracer.Backends.C.Parser 62 | , Language.Bracer.Backends.C.Parser.Expressions 63 | , Language.Bracer.Backends.C.Parser.Identifiers 64 | , Language.Bracer.Backends.C.Parser.Internal 65 | , Language.Bracer.Backends.C.Parser.Literals 66 | , Language.Bracer.Backends.C.Parser.Statements 67 | , Language.Bracer.Backends.C.Parser.Types 68 | , Language.Bracer.Backends.C.Parser.Variables 69 | , Language.Bracer.Backends.C.Pretty 70 | , Language.Bracer.Backends.C.Scribe 71 | , Language.Bracer.Backends.C.Syntax 72 | , Language.Bracer.Backends.Swift 73 | , Language.Bracer.Backends.Swift.Syntax 74 | 75 | ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fwarn-tabs 76 | other-modules: Overture 77 | 78 | executable test 79 | build-depends: base 80 | , bracer 81 | , ansi-wl-pprint 82 | , bytestring 83 | , compdata 84 | , hashable 85 | , data-default 86 | , lens 87 | , mtl 88 | , parsers 89 | , scientific 90 | , semigroups 91 | , trifecta 92 | , vector 93 | , unordered-containers 94 | , utf8-string 95 | , hspec == 2.* 96 | , HUnit 97 | , QuickCheck 98 | 99 | default-language: Haskell2010 100 | 101 | default-extensions: ConstraintKinds 102 | , DeriveFunctor 103 | , DeriveFoldable 104 | , DeriveGeneric 105 | , DeriveTraversable 106 | , FlexibleContexts 107 | , FlexibleInstances 108 | , GeneralizedNewtypeDeriving 109 | , KindSignatures 110 | , MultiParamTypeClasses 111 | , OverloadedStrings 112 | , QuasiQuotes 113 | , RankNTypes 114 | , StandaloneDeriving 115 | , TemplateHaskell 116 | , TypeFamilies 117 | , TypeOperators 118 | , UndecidableInstances 119 | 120 | main-is: Test.hs 121 | 122 | ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fwarn-tabs 123 | other-modules: Overture 124 | 125 | executable c2swift 126 | build-depends: base 127 | , bracer 128 | , ansi-wl-pprint 129 | , bytestring 130 | , compdata 131 | , hashable 132 | , data-default 133 | , lens 134 | , mtl 135 | , parsers 136 | , scientific 137 | , semigroups 138 | , trifecta 139 | , vector 140 | , unordered-containers 141 | , utf8-string 142 | 143 | default-language: Haskell2010 144 | 145 | default-extensions: ConstraintKinds 146 | , DeriveFunctor 147 | , DeriveFoldable 148 | , DeriveGeneric 149 | , DeriveTraversable 150 | , FlexibleContexts 151 | , FlexibleInstances 152 | , GeneralizedNewtypeDeriving 153 | , KindSignatures 154 | , MultiParamTypeClasses 155 | , OverloadedStrings 156 | , QuasiQuotes 157 | , RankNTypes 158 | , StandaloneDeriving 159 | , TemplateHaskell 160 | , TypeFamilies 161 | , TypeOperators 162 | , UndecidableInstances 163 | 164 | main-is: C2Swift.hs 165 | 166 | ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fwarn-tabs 167 | other-modules: Overture 168 | -------------------------------------------------------------------------------- /docs/c_declarations.md: -------------------------------------------------------------------------------- 1 | Uninitialized, named declarator of simple type: 2 | 3 | int x; 4 | float y; 5 | char z; 6 | 7 | Uninitialized, named declarator of derived type: 8 | 9 | uint8_t buffer[2048][16]; 10 | fpos_t (*_seek) (void *, fpos_t, int); 11 | 12 | Function pointer declaration with function pointer argument: 13 | 14 | void (*signal(int sig, void (*func)(int)))(int); 15 | 16 | Named declarator of derived type with compound initializer: 17 | 18 | int a[2][2] = {{1, 2}, {3, 4}}; 19 | 20 | Declaration of named composite type, without typedef: 21 | 22 | struct __sbuf { 23 | unsigned char *_base; 24 | int _size; 25 | }; 26 | 27 | Declaration of variable of anonymous enum type with trailing commas: 28 | 29 | enum { red, blue, green, } color; 30 | 31 | 32 | Forward declaration of variadic function with anonymous parameters: 33 | 34 | int snprintf(char * __restrict, size_t, const char * __restrict, ...) 35 | 36 | Forward declaration of function with function-pointer parameters with unnamed parameters: 37 | 38 | FILE *funopen(const void *, 39 | int (*)(void *, char *, int), 40 | int (*)(void *, const char *, int), 41 | fpos_t (*)(void *, fpos_t, int), 42 | int (*)(void *)); 43 | 44 | Forward declaration of composite type: 45 | 46 | struct __sFILEX; 47 | 48 | Simultaneous typedef and forward declaration of composite type: 49 | 50 | typedef struct cache_s cache_t; 51 | 52 | Typedef of function pointer: 53 | 54 | typedef uintptr_t (*cache_key_hash_cb_t)(void *key, void *user_data); 55 | 56 | Struct with flexible array member as its last field: 57 | 58 | struct s { int n; double d[]; }; 59 | 60 | Evil structure that uses one compound declaration with sized, anonymous, untyped members for padding bits: 61 | 62 | struct __darwin_fp_control 63 | { 64 | unsigned short __invalid :1, 65 | __denorm :1, 66 | __zdiv :1, 67 | __ovrfl :1, 68 | __undfl :1, 69 | __precis :1, 70 | :2, 71 | __pc :2, 72 | __rc :2, 73 | :1, 74 | :3; 75 | }; 76 | 77 | Function with variably-sized argument: 78 | 79 | void doStuff(size_t n, char foo[n]) {} 80 | 81 | Scoped typedefs: 82 | 83 | char foo() { 84 | typedef char MyType; 85 | MyType c = 'a'; 86 | returhn c; 87 | } -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2016-06-21 2 | packages: 3 | - '.' 4 | - location: 5 | git: git@github.com:ekmett/trifecta 6 | commit: 53f76115ceba688fb0f5aef2fea5d085a1f813ec 7 | extra-dep: true 8 | extra-deps: 9 | - compdata-0.10.1 10 | - trifecta-1.5.2 11 | - tree-view-0.4 12 | --------------------------------------------------------------------------------