packages feed

c-dsl (empty) → 0.1.0.0

raw patch · 8 files changed

+369/−0 lines, 8 filesdep +basedep +language-csetup-changed

Dependencies added: base, language-c

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) <year> <copyright holders>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ c-dsl.cabal view
@@ -0,0 +1,27 @@+name:                c-dsl+version:             0.1.0.0+synopsis:            A higher level DSL on top of language-c+description:         This DSL is meant to make it easier to write language-c's DSL by providing simple+                     functions/operators for writing C AST's in Haskell+license:             MIT+license-file:        LICENSE+author:              Danny Gratzer+maintainer:          danny.gratzer@gmail.com+category:            Language+build-type:          Simple+cabal-version:       >=1.10+source-repository head+                  type:     hg+                  location: http://bitbucket.org/jozefg/c-dsl+library+   exposed-modules:     Language.C.DSL,+                        Language.C.DSL.Decl,+                        Language.C.DSL.Stat,+                        Language.C.DSL.Exp,+                        Language.C.DSL.StringLike+  +  build-depends:       base >=4.6 && <4.7,+                       language-c+  hs-source-dirs:      src/+  default-language:    Haskell2010+
+ src/Language/C/DSL.hs view
@@ -0,0 +1,17 @@+-- | This module simply exists to export the entirety of the DSL and as+-- a convenience, "Language.C".++++module Language.C.DSL (+  module Language.C.DSL.StringLike,+  module Language.C.DSL.Exp,+  module Language.C.DSL.Stat,+  module Language.C.DSL.Decl,+  module Language.C) where++import Language.C+import Language.C.DSL.StringLike+import Language.C.DSL.Exp+import Language.C.DSL.Stat+import Language.C.DSL.Decl
+ src/Language/C/DSL/Decl.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleInstances #-}+module Language.C.DSL.Decl where+import Language.C+import Data.String+import Language.C.DSL.StringLike++-- | A low level way to declare something.+decl :: CDeclSpec -> CDeclr -> Maybe CExpr -> CDecl+decl ty name exp = CDecl [ty] [(Just name, flip CInitExpr undefNode `fmap` exp, Nothing)] undefNode++-- | Simple types that can be used in declarations.+voidTy, charTy, shortTy, intTy, longTy, floatTy :: CDeclSpec+voidTy   = CTypeSpec $ CVoidType undefNode+charTy   = CTypeSpec $ CCharType undefNode+shortTy  = CTypeSpec $ CShortType undefNode+intTy    = CTypeSpec $ CIntType undefNode+longTy   = CTypeSpec $ CLongType undefNode+floatTy  = CTypeSpec $ CFloatType undefNode+doubleTy = CTypeSpec $ CDoubleType undefNode++-- | Modifies a declarator to be a pointer. For example+-- @ptr "x"@ would be @*x@ in C.+ptr :: CDeclr -> CDeclr+ptr (CDeclr nm mods cstr attrs node) = CDeclr nm (CPtrDeclr [] undefNode : mods) cstr attrs node++-- | Clever functions that can be applied to declarators, for example @int "x" .= 1@ is equivalent+-- to @int x = 1@. To leave a variable uninitialized @int "x" Nothing@ does the job.+char, short, int, long, float, double :: CDeclr -> Maybe CExpr -> CDecl+char   = decl charTy+short  = decl shortTy+int    = decl intTy+long   = decl longTy+float  = decl floatTy+double = decl doubleTy++-- | Equivalent to the above but with pointer wrappers.+charPtr, shortPtr, intPtr, longPtr, floatPtr, doublePtr :: CDeclr -> Maybe CExpr -> CDecl+charPtr   = char . ptr+shortPtr  = short . ptr+intPtr    = int . ptr+longPtr   = long . ptr+floatPtr  = float . ptr+doublePtr = double . ptr++-- | Supplies an initializer for an expression.+(.=) :: (Maybe CExpr -> CDecl) -> CExpr -> CDecl+f .= e = f (Just e)+infixl 7 .=++-- | Leave a declaration uninitialized. For example @uninit $ char "x"@.+uninit :: (Maybe CExpr -> CDecl) -> CDecl+uninit = ($ Nothing)++csu :: CStructTag -> String -> [(String, CTypeSpec)] -> CDecl+csu tag ident fields = CDecl+                       [CStorageSpec $ CTypedef undefNode, CTypeSpec $ CSUType structTy undefNode]+                       [(Just $ fromString ident, Nothing, Nothing)]+                       undefNode+  where structTy  = CStruct tag (Just $ fromString ident) (Just $ map structify fields) [] undefNode+        structify (name, ty) = CDecl [CTypeSpec ty] [(Just (fromString name), Nothing, Nothing)] undefNode++struct, union :: String -> [(String, CTypeSpec)] -> CDecl+-- ^ Create a structure or union, for example @struct "foo" [("bar", intTy)]@ is+-- @typedef struct foo {int bar;} foo;@+struct = csu CStructTag+union  = csu CUnionTag++-- Defines a C function. For example+-- >    test =+-- >       fun [intTy] "test"[int "a", int "b"] $ hblock [+-- >           creturn ("a" + "b")+-- >       ]+-- Would be the equivalent of+-- >   int test(int a, int b)+-- >   {+-- >      return a + b;+-- >   }+fun :: [CDeclSpec] -> String -> [Maybe CExpr -> CDecl] -> CStat -> CFunDef+fun specs name args body = CFunDef specs decl [] body undefNode+  where decl = CDeclr (Just $ fromString name)+               [CFunDeclr (Right (fmap ($Nothing) args, False)) [] undefNode]+               Nothing [] undefNode++class External a where+  export :: a -> CExtDecl+instance External CFunDef where+  export = CFDefExt+instance External CDecl where+  export = CDeclExt+instance External CStrLit where+  export = flip CAsmExt undefNode++-- | Exports a series of declarations to a translation unit.+transUnit :: [CExtDecl] -> CTranslUnit+transUnit = flip CTranslUnit undefNode+
+ src/Language/C/DSL/Exp.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE FlexibleInstances #-}+-- | This module contians the DSL for writing @CExpr@s.+-- It doesn't export the orphan instance for @IsString CExpr@ which+-- can be found in "Language.C.DSL.StringLike".+module Language.C.DSL.Exp where+import Language.C+import Data.String+import Language.C.DSL.StringLike++-- | Lift a Haskell string into a literal C string.+str :: String -> CExpr+str = CConst . flip CStrConst undefNode . cString++cOp :: CBinaryOp -> CExpr -> CExpr -> CExpr+cOp op a b = CBinary op a b undefNode++-- | Comparison operators, normal haskell operators with @:@ at the end.+(==:), (/=:), (<:), (>:), (<=:), (>=:) :: CExpr -> CExpr -> CExpr+(==:) = cOp CEqOp+(/=:) = cOp CNeqOp+(<:)  = cOp CLeOp+(>:)  = cOp CGrOp+(<=:) = cOp CLeqOp+(>=:) = cOp CGeqOp++-- | The ternary operator in C. @ternary a b c@ will turn into @a ? b : c@.+ternary :: CExpr -> CExpr -> CExpr -> CExpr+ternary i t e = CCond i (Just t) e undefNode++-- | An orphan @Num@ instance for @CExpr@. It provides inline implementations+-- of @abs@ and @signum@ that don't rely on @math.h@.+instance Num CExpr where+  fromInteger = CConst . flip CIntConst undefNode . cInteger+  (*)         = cOp CMulOp+  (+)         = cOp CAddOp+  (-)         = cOp CSubOp+  abs a       = ternary (a >=: 0) a (negate a)+  signum a    = ternary (a >=: 0) (ternary (a ==: 0) a 1) (-1)+instance Fractional CExpr where+  (/)          = cOp CDivOp+  fromRational = CConst . flip CFloatConst undefNode . cFloat . fromRational++-- | A function mapping identifier in C to be used as variables. Normally this can be+-- avoided since "Language.C.DSL.StringLike" provides an 'IsString' instance.+var :: Ident -> CExpr+var = flip CVar undefNode++-- | Function calls, @f#[a, b, c]@ will become @f(a, b, c)@. Note+-- that @f@ is also an expression.+(#) :: CExpr -> [CExpr] -> CExpr+f # args = CCall f args undefNode++-- | The assignment operator. @var <-- value@ will become @var = value;@ in C.+(<--) :: CExpr -> CExpr -> CExpr+var <-- val = CAssign CAssignOp var val undefNode+infixl 3 <--++-- | This is the more generalized version of '(<--)'. It allows+-- any 'CAssignOp' to be passed in to facilitate writing @a += b@ and+-- similar.+assign :: CAssignOp -> CExpr -> CExpr -> CExpr+assign mode var val = CAssign mode var val undefNode+++-- | A simplified unary operator type. It+-- can be converted to 'Language.C's version using+-- 'toCUnaryOp'.+data UnOp = PlusPlus+          | MinusMinus+          | Minus+          | Plus+          | Not+          | Addr -- ^ The address of operator @&@.+          | Ind -- ^ The dereferencing operator in C @*@.+          deriving(Eq, Show)++-- | Convert a 'UnOp' to the corresponding 'CUnaryOp'.+toCUnaryOp :: UnOp -> CUnaryOp+toCUnaryOp Minus = CMinOp+toCUnaryOp Plus  = CPlusOp+toCUnaryOp Not   = CNegOp+toCUnaryOp Addr  = CAdrOp+toCUnaryOp Ind   = CIndOp++-- | Apply a unary operator prefix, @op `pre` exp@ will transform into something like @op exp@+-- in C. This only matters for 'PlusPlus' and 'MinusMinus'.+pre   :: UnOp -> CExpr -> CExpr+PlusPlus   `pre` exp = CUnary CPreIncOp exp undefNode+MinusMinus `pre` exp = CUnary CPreDecOp exp undefNode+op         `pre` exp = CUnary (toCUnaryOp op) exp undefNode++-- | The postfix equivalent of 'pre'.+post  :: CExpr -> UnOp -> CExpr+exp `post` PlusPlus   = CUnary CPostIncOp exp undefNode+exp `post` MinusMinus = CUnary CPostDecOp exp undefNode+exp `post` op         = CUnary (toCUnaryOp op) exp undefNode++-- | A quick wrapper of @pre Ind exp@ since it's so common.+star :: CExpr -> CExpr+star = pre Ind++-- | The C comma operator, @comma [a, b, c]@ is equivalent to @a, b, c@ in C.+comma :: [CExpr] -> CExpr+comma = flip CComma undefNode++-- | Implements C style casts for expressions.+castTo :: CExpr -> CDecl -> CExpr+exp `castTo` ty = CCast ty exp undefNode++-- | @size of@ for types. +sizeOfDecl :: CDecl -> CExpr+sizeOfDecl = flip CSizeofType undefNode++-- | @size of@ for expressions. Carefully note that @sizeOf "someType"@ will+-- incorrectly treat @someType@ as a variable, not a type.+sizeOf :: CExpr -> CExpr+sizeOf = flip CSizeofExpr undefNode++-- | Access a field of a struct, this C's @.@ operator.+(&) :: CExpr -> String -> CExpr+struct & field = CMember struct (fromString field) False undefNode+infixl 8 &++-- | The automatic dereferencing @->@ in C.+(&*) :: CExpr -> String -> CExpr+struct &* field = CMember struct (fromString field) True undefNode+infixl 8 &*++-- | This is the indexing operator in C, @a ! i@ is @a[i]@.+(!) :: CExpr -> CExpr -> CExpr+arr ! ind = CIndex arr ind undefNode+infixl 8 !
+ src/Language/C/DSL/Stat.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}+module Language.C.DSL.Stat where+import Language.C++-- | An if statement with no else clause+cif :: CExpr -> CStat -> CStat+cif exp stat = CIf exp stat Nothing undefNode++-- | An if statement with an else clause+cifElse :: CExpr -> CStat -> CStat -> CStat+cifElse exp th el = CIf exp th (Just el) undefNode++-- | A while loop, the 'CExpr' is the looping condition.+while :: CExpr -> CStat -> CStat+while exp stat = CWhile exp stat False undefNode++-- | A for loop, an example use+-- > for(int "x" .= 1, 1, PlusPlus `pre` "x")+-- >   "printf"#[str "%d\n", "x"]+for :: (CDecl, CExpr, CExpr) -> CStat -> CStat+for (init, test, upd) block = CFor (Right init) (Just test) (Just upd) block undefNode++-- | A for loop with no declarations.+noDeclFor :: (CExpr, CExpr) -> CStat -> CStat+noDeclFor (test, upd) block = CFor (Left Nothing) (Just test) (Just upd) block undefNode++-- | A do while loop.+doWhile :: CExpr -> CStat -> CStat+doWhile exp stat = CWhile exp stat True undefNode++cbreak :: CStat+cbreak = CBreak undefNode++ccont :: CStat+ccont = CCont undefNode++creturn :: CExpr -> CStat+creturn = flip CReturn undefNode . Just++cvoidReturn :: CStat+cvoidReturn = CReturn Nothing undefNode++liftE :: CExpr -> CStat+liftE e = CExpr (Just e) undefNode++class BlockLike a where+  intoB :: a -> CBlockItem+instance BlockLike CStat where+  intoB = CBlockStmt+instance BlockLike CExpr where+  intoB = intoB . liftE+instance BlockLike CDecl where+  intoB = CBlockDecl++block :: [CBlockItem] -> CStat+block = flip (CCompound []) undefNode++hBlock :: BlockLike a => [a] -> CStat+hBlock = block . map intoB+
+ src/Language/C/DSL/StringLike.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE FlexibleInstances #-}+-- | The home of all the orphaned 'IsString' instances+-- used throughout the DSL.+module Language.C.DSL.StringLike where+import Data.String+import Language.C+instance IsString Ident where+  fromString = internalIdent+instance IsString CExpr where+  fromString s = CVar (fromString s) undefNode+instance IsString CDeclr where+  fromString str = CDeclr (Just $ fromString str) [] Nothing [] undefNode+instance IsString CDecl where+  fromString str = CDecl [CTypeSpec (CTypeDef (fromString str) undefNode)] [] undefNode