packages feed

language-c-quote 0.11.5 → 0.11.5.1

raw patch · 6 files changed

+230/−87 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Language.C.Parser.Parser: mkBlock :: [BlockItem] -> SrcLoc -> Stm
+ Language.C.Parser.Parser: mkBlockItems :: Stm -> [BlockItem]
+ Language.C.Pretty: parensOp :: CFixity a => Int -> a -> Doc -> Doc
+ Language.C.Pretty: pprBlock :: Stm -> Doc
- Language.C.Pretty: class CFixity a
+ Language.C.Pretty: class CFixity a where parensOp prec op = parensIf (prec > opPrec) where Fixity _ opPrec = fixity op

Files

Language/C/Parser/Parser.y view
@@ -490,10 +490,7 @@   | '(' expression_nlt error       {% unclosed ($1 <--> $2) "(" }   | '(' compound_statement ')'-      { let Block items _ = $2-        in-          StmExpr items ($1 `srcspan` $3)-      }+      { StmExpr (mkBlockItems $2) ($1 `srcspan` $3) }   | ANTI_ESC       { AntiEscExp (getANTI_ESC $1) (srclocOf $1) }   | ANTI_EXP@@ -758,10 +755,7 @@   | '(' expression_nlt error       {% unclosed ($1 <--> $2) "(" }   | '(' compound_statement ')'-      { let Block items _ = $2-        in-          StmExpr items ($1 `srcspan` $3)-      }+      { StmExpr (mkBlockItems $2) ($1 `srcspan` $3) }   | ANTI_ESC       { AntiEscExp (getANTI_ESC $1) (srclocOf $1) }   | ANTI_EXP@@ -2074,9 +2068,9 @@ compound_statement :: { Stm } compound_statement:     '{' begin_scope end_scope '}'-      { Block [] ($1 `srcspan` $4) }+      { mkBlock [] ($1 `srcspan` $4) }   | '{' begin_scope block_item_list end_scope '}'-      { Block $3 ($1 `srcspan` $5) }+      { mkBlock $3 ($1 `srcspan` $5) }   | '{' begin_scope error       {% unclosed (locOf $3) "{" } @@ -2220,7 +2214,7 @@     declaration_specifiers declarator compound_statement       {% do{ let (dspec, declRoot)   =  $1            ; let (ident, declToDecl) =  $2-           ; let Block blockItems _  =  $3+           ; let blockItems          =  mkBlockItems $3            ; let decl                =  declToDecl declRoot            ; case decl of                { Proto protoDecl args _ -> return $@@ -2240,7 +2234,7 @@       {% do{ let (dspec, declRoot)   =  $1            ; let (ident, declToDecl) =  $2            ; let argDecls            =  $3-           ; let Block blockItems _  =  $4+           ; let blockItems          =  mkBlockItems $4            ; let decl                =  declToDecl declRoot            ; case decl of                { OldProto protoDecl args _ -> return $@@ -2448,23 +2442,22 @@ block_literal :     '^'                                              attribute_specifiers_opt compound_statement       {% do { assertBlocksEnabled ($1 <--> $3) "To use blocks, enable the blocks language extension"-            ; let Block items _ = $3+            ; let items = mkBlockItems $3             ; return $ BlockLit (BlockVoid (srclocOf $1)) $2 items ($1 `srcspan` $3)             }       }   | '^' '(' parameter_list ')'                       attribute_specifiers_opt compound_statement       {% do { assertBlocksEnabled ($1 <--> $6) "To use blocks, enable blocks language extension"-            ; let Block items _ = $6+            ; let items = mkBlockItems $6             ; return $ BlockLit (BlockParam $3 ($2 `srcspan` $4)) $5 items ($1 `srcspan` $6)             }       }   | '^' specifier_qualifier_list abstract_declarator attribute_specifiers_opt compound_statement       {% do { assertBlocksEnabled ($1 <--> $5) "To use blocks, enable blocks language extension"-            ; let { decl          = $3 (declRoot $2)-                  ; Block items _ = $5-                  }-            ; dspec <- mkDeclSpec $2-            ; let typeLoc = dspec `srcspan` decl+            ; let decl    =  $3 (declRoot $2)+            ; let items   =  mkBlockItems $5+            ; dspec       <- mkDeclSpec $2+            ; let typeLoc =  dspec `srcspan` decl             ; return $ BlockLit (BlockType (Type dspec decl typeLoc) typeLoc) $4 items ($1 `srcspan` $5)             }       }@@ -2527,15 +2520,15 @@ objc_at_statement :: { Stm } objc_at_statement :     '@' 'try' compound_statement objc_catch_statement_rlist '@' 'finally' compound_statement-      { let { Block tryItems _     = $3-            ; Block finallyItems _ = $7+      { let { tryItems     = mkBlockItems $3+            ; finallyItems = mkBlockItems $7             }         in          ObjCTry tryItems (rev $4) (Just finallyItems) ($1 `srcspan` $7)       }   | '@' 'try' compound_statement objc_catch_statement_rlist-      {% do { let { Block tryItems _ = $3-                  ; catchStmts       = rev $4+      {% do { let { tryItems   = mkBlockItems $3+                  ; catchStmts = rev $4                   }             ; when (null catchStmts) $                 throw $ ParserException ($1 <--> $3) $@@ -2556,12 +2549,12 @@   | '@' 'throw' error       {% expected ["';'", "expression"] Nothing }   | '@' 'synchronized' '(' expression ')' compound_statement-      { let Block items _ = $6+      { let items = mkBlockItems $6         in          ObjCSynchronized $4 items ($1 `srcspan` $6)       }   | '@' 'autoreleasepool' compound_statement-      { let Block items _ = $3+      { let items = mkBlockItems $3         in          ObjCAutoreleasepool items ($1 `srcspan` $3)       }@@ -2571,11 +2564,11 @@     {- empty -}       { rnil }   | objc_catch_statement_rlist '@' 'catch' '(' parameter_declaration ')' compound_statement-      { let Block items _ = $7+      { let items = mkBlockItems $7         in         rcons (ObjCCatch (Just $5) items ($2 `srcspan` $7)) $1 }   | objc_catch_statement_rlist '@' 'catch' '(' '...' ')' compound_statement-      { let Block items _ = $7+      { let items = mkBlockItems $7         in         rcons (ObjCCatch Nothing items ($2 `srcspan` $7)) $1 } @@ -3224,14 +3217,14 @@ objc_method_definition :: { Definition } objc_method_definition :     objc_method_proto semi compound_statement-      { let Block stmts loc = $3+      { let stmts = mkBlockItems $3         in-          ObjCMethDef $1 stmts ($1 `srcspan` loc)+          ObjCMethDef $1 stmts ($1 `srcspan` $3)       }-  | objc_method_proto     compound_statement-      { let Block stmts loc = $2+  | objc_method_proto      compound_statement+      { let stmts = mkBlockItems $2         in-          ObjCMethDef $1 stmts ($1 `srcspan` loc)+          ObjCMethDef $1 stmts ($1 `srcspan` $2)       }   | ANTI_OBJC_METHOD_DEF       { AntiObjCMeth (getANTI_OBJC_METHOD_DEF $1) (srclocOf $1) }@@ -3259,7 +3252,7 @@ cuda_lambda_expression :: { Exp } cuda_lambda_expression : cuda_lambda_introducer cuda_lambda_declarator compound_statement     {% do { assertCudaEnabled ($1 <--> $3) "To use lambda-expressions, enable support for CUDA"-          ; let Block items _ = $3+          ; let items = mkBlockItems $3           ; return $ Lambda $1 $2 items ($1 `srcspan` $3)           }     }@@ -4000,6 +3993,14 @@  cuda_enabled <- useCUDAExts  unless cuda_enabled $   throw $ ParserException loc $ text errMsg++mkBlock :: [BlockItem] -> SrcLoc -> Stm+mkBlock [BlockStm stm] _    = stm+mkBlock items          sloc = Block items sloc++mkBlockItems :: Stm -> [BlockItem]+mkBlockItems (Block items _) = items+mkBlockItems stm             = [BlockStm stm]  mkCommentStm :: L T.Token -> Stm -> Stm mkCommentStm tok stm = Comment (getCOMMENT tok) stm (srclocOf tok)
Language/C/Pretty.hs view
@@ -47,7 +47,7 @@         -> b   -- ^ right argument         -> Doc infixop prec op l r =-    parensIf (prec > opPrec) $+    parensOp prec op $     pprPrec leftPrec l <+> ppr op <+/> pprPrec rightPrec r   where     leftPrec | opAssoc == RightAssoc = opPrec + 1@@ -107,6 +107,12 @@ class CFixity a where     fixity :: a -> Fixity +    parensOp :: Int -> a -> Doc -> Doc+    parensOp prec op =+        parensIf (prec > opPrec)+      where+        Fixity _ opPrec = fixity op+ -- -- Fixities are taken from Table 2-1 in Section 2.12 of K&R (2nd ed.) --@@ -154,6 +160,35 @@     fixity Lsh  = infixl_ 11     fixity Rsh  = infixl_ 11 +    parensOp prec op =+        go op+      where+        go :: BinOp -> Doc -> Doc+        go Add  | isBitwiseOp = parens+        go Sub  | isBitwiseOp = parens+        go Land | isOp Lor    = parens+        go Lor  | isOp Land   = parens+        go And  | isOp Or     = parens+                | isOp Xor    = parens+        go Or   | isOp And    = parens+                | isOp Xor    = parens+        go Xor  | isOp And    = parens+                | isOp Or     = parens+        go _                  = parensIf (prec > opPrec)++        isBitwiseOp :: Bool+        isBitwiseOp = isOp And || isOp Or || isOp Xor++        -- Return 'True' if we are potentially an immediate subterm of the+        -- binary operator op'. We make this determination based of the value of+        -- @prec@.+        isOp :: BinOp -> Bool+        isOp op' = prec == op'Prec || prec == op'Prec + 1+          where+            Fixity _ op'Prec = fixity op'++        Fixity _ opPrec = fixity op+ instance CFixity AssignOp where     fixity _ = infixr_ 2 @@ -555,36 +590,40 @@     ppr (If test then' maybe_else sloc) =         srcloc sloc <>         text "if" <+> parens (ppr test) <>-        pprStm then' (fmap pprElse maybe_else)+        pprThen then' (fmap pprElse maybe_else)       where-        pprElse :: Stm -> Doc-        pprElse else' = text "else" <> pprStm else' Nothing+        pprThen :: Stm -> Maybe Doc -> Doc+        pprThen stm@(Block {}) rest        = space <> ppr stm <+> maybe empty id rest+        pprThen stm@(If {})    rest        = space <> ppr [BlockStm stm] <+> maybe empty id rest+        pprThen stm            Nothing     = nest 4 (line <> ppr stm)+        pprThen stm            (Just rest) = nest 4 (line <> ppr stm) </> rest -        pprStm :: Stm -> Maybe Doc -> Doc-        pprStm stm@(Block {}) rest        = space <> ppr stm <+> maybe empty id rest-        pprStm stm@(If {})    rest        = space <> ppr stm <+> maybe empty id rest-        pprStm stm            Nothing     = nest 4 (line <> ppr stm)-        pprStm stm            (Just rest) = nest 4 (line <> ppr stm) </> rest+        pprElse :: Stm -> Doc+        pprElse stm =+            text "else" <> go stm+          where+            go :: Stm -> Doc+            go (Block {}) = space <> ppr stm+            go (If {})    = space <> ppr stm+            go _stm       = nest 4 (line <> ppr stm)      ppr (Switch e stm sloc) =         srcloc sloc <>-        text "switch" <+> parens (ppr e) <+/> ppr stm+        text "switch" <+> parens (ppr e) <> pprBlock stm      ppr (While e stm sloc) =         srcloc sloc <>-        text "while" <+> parens (ppr e) <+/> ppr stm+        text "while" <+> parens (ppr e) <> pprBlock stm      ppr (DoWhile stm e sloc) =         srcloc sloc <>-        text "do" <+/> ppr stm <+/> text "while" <> parens (ppr e) <> semi+        text "do" <> pprBlock stm <+/> text "while" <> parens (ppr e) <> semi      ppr (For ini test post stm sloc) =         srcloc sloc <>         text "for" <+>         (parens . semisep) [either ppr ppr ini, ppr test, ppr post] <>-        case stm of-          Block {} -> space <> ppr stm-          _ -> nest 4 $ line <> ppr stm+        pprBlock stm      ppr (Goto ident sloc) =         srcloc sloc <>@@ -681,6 +720,11 @@         srcloc sloc         <>  text "@autoreleasepool"         </> ppr block++pprBlock :: Stm -> Doc+pprBlock stm@(Block {}) = space <> ppr stm+pprBlock stm@(If {})    = space <> ppr [BlockStm stm]+pprBlock stm            = nest 4 $ line <> ppr stm  instance Pretty BlockItem where     ppr (BlockDecl decl) = ppr decl <> semi
dist/build/Language/C/Parser/Lexer.hs view
@@ -574,8 +574,9 @@ alex_action_125 =  token TCUDA3gt  {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-}-{-# LINE 8 "<command-line>" #-}+{-# LINE 9 "<command-line>" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4  # 17 "/usr/include/stdc-predef.h" 3 4@@ -621,7 +622,26 @@   -{-# LINE 8 "<command-line>" #-}+{-# LINE 9 "<command-line>" #-}+{-# LINE 1 "/home/mainland/software/haskell-platform-7.10.3/build/ghc-bindist/local/lib/ghc-7.10.3/include/ghcversion.h" #-}++++++++++++++++++{-# LINE 9 "<command-line>" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE
dist/build/Language/C/Parser/Parser.hs view
@@ -33,8 +33,9 @@ import qualified Data.Array as Happy_Data_Array import qualified GHC.Exts as Happy_GHC_Exts import Control.Applicative(Applicative(..))+import Control.Monad (ap) --- parser produced by Happy Version 1.19.4+-- parser produced by Happy Version 1.19.5  newtype HappyAbsSyn  = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607@@ -2672,9 +2673,7 @@ 	case happyOut142 happy_x_2 of { happy_var_2 ->  	case happyOutTok happy_x_3 of { happy_var_3 ->  	happyIn36-		 (let Block items _ = happy_var_2-        in-          StmExpr items (happy_var_1 `srcspan` happy_var_3)+		 (StmExpr (mkBlockItems happy_var_2) (happy_var_1 `srcspan` happy_var_3) 	)}}}  happyReduce_88 = happySpecReduce_1  7# happyReduction_88@@ -3622,9 +3621,7 @@ 	case happyOut142 happy_x_2 of { happy_var_2 ->  	case happyOutTok happy_x_3 of { happy_var_3 ->  	happyIn59-		 (let Block items _ = happy_var_2-        in-          StmExpr items (happy_var_1 `srcspan` happy_var_3)+		 (StmExpr (mkBlockItems happy_var_2) (happy_var_1 `srcspan` happy_var_3) 	)}}}  happyReduce_189 = happySpecReduce_1  30# happyReduction_189@@ -7407,7 +7404,7 @@ 	 = case happyOutTok happy_x_1 of { happy_var_1 ->  	case happyOutTok happy_x_4 of { happy_var_4 ->  	happyIn142-		 (Block [] (happy_var_1 `srcspan` happy_var_4)+		 (mkBlock [] (happy_var_1 `srcspan` happy_var_4) 	) `HappyStk` happyRest}}  happyReduce_594 = happyReduce 5# 113# happyReduction_594@@ -7421,7 +7418,7 @@ 	case happyOut143 happy_x_3 of { happy_var_3 ->  	case happyOutTok happy_x_5 of { happy_var_5 ->  	happyIn142-		 (Block happy_var_3 (happy_var_1 `srcspan` happy_var_5)+		 (mkBlock happy_var_3 (happy_var_1 `srcspan` happy_var_5) 	) `HappyStk` happyRest}}}  happyReduce_595 = happyMonadReduce 3# 113# happyReduction_595@@ -8048,7 +8045,7 @@ 	case happyOut142 happy_x_3 of { happy_var_3 ->  	( do{ let (dspec, declRoot)   =  happy_var_1            ; let (ident, declToDecl) =  happy_var_2-           ; let Block blockItems _  =  happy_var_3+           ; let blockItems          =  mkBlockItems happy_var_3            ; let decl                =  declToDecl declRoot            ; case decl of                { Proto protoDecl args _ -> return $@@ -8078,7 +8075,7 @@ 	( do{ let (dspec, declRoot)   =  happy_var_1            ; let (ident, declToDecl) =  happy_var_2            ; let argDecls            =  happy_var_3-           ; let Block blockItems _  =  happy_var_4+           ; let blockItems          =  mkBlockItems happy_var_4            ; let decl                =  declToDecl declRoot            ; case decl of                { OldProto protoDecl args _ -> return $@@ -8708,7 +8705,7 @@ 	case happyOut160 happy_x_2 of { happy_var_2 ->  	case happyOut142 happy_x_3 of { happy_var_3 ->  	( do { assertBlocksEnabled (happy_var_1 <--> happy_var_3) "To use blocks, enable the blocks language extension"-            ; let Block items _ = happy_var_3+            ; let items = mkBlockItems happy_var_3             ; return $ BlockLit (BlockVoid (srclocOf happy_var_1)) happy_var_2 items (happy_var_1 `srcspan` happy_var_3)             })}}} 	) (\r -> happyReturn (happyIn180 r))@@ -8728,7 +8725,7 @@ 	case happyOut160 happy_x_5 of { happy_var_5 ->  	case happyOut142 happy_x_6 of { happy_var_6 ->  	( do { assertBlocksEnabled (happy_var_1 <--> happy_var_6) "To use blocks, enable blocks language extension"-            ; let Block items _ = happy_var_6+            ; let items = mkBlockItems happy_var_6             ; return $ BlockLit (BlockParam happy_var_3 (happy_var_2 `srcspan` happy_var_4)) happy_var_5 items (happy_var_1 `srcspan` happy_var_6)             })}}}}}} 	) (\r -> happyReturn (happyIn180 r))@@ -8746,11 +8743,10 @@ 	case happyOut160 happy_x_4 of { happy_var_4 ->  	case happyOut142 happy_x_5 of { happy_var_5 ->  	( do { assertBlocksEnabled (happy_var_1 <--> happy_var_5) "To use blocks, enable blocks language extension"-            ; let { decl          = happy_var_3 (declRoot happy_var_2)-                  ; Block items _ = happy_var_5-                  }-            ; dspec <- mkDeclSpec happy_var_2-            ; let typeLoc = dspec `srcspan` decl+            ; let decl    =  happy_var_3 (declRoot happy_var_2)+            ; let items   =  mkBlockItems happy_var_5+            ; dspec       <- mkDeclSpec happy_var_2+            ; let typeLoc =  dspec `srcspan` decl             ; return $ BlockLit (BlockType (Type dspec decl typeLoc) typeLoc) happy_var_4 items (happy_var_1 `srcspan` happy_var_5)             })}}}}} 	) (\r -> happyReturn (happyIn180 r))@@ -8855,8 +8851,8 @@ 	case happyOut186 happy_x_4 of { happy_var_4 ->  	case happyOut142 happy_x_7 of { happy_var_7 ->  	happyIn185-		 (let { Block tryItems _     = happy_var_3-            ; Block finallyItems _ = happy_var_7+		 (let { tryItems     = mkBlockItems happy_var_3+            ; finallyItems = mkBlockItems happy_var_7             }         in          ObjCTry tryItems (rev happy_var_4) (Just finallyItems) (happy_var_1 `srcspan` happy_var_7)@@ -8871,8 +8867,8 @@ 	 = happyThen (case happyOutTok happy_x_1 of { happy_var_1 ->  	case happyOut142 happy_x_3 of { happy_var_3 ->  	case happyOut186 happy_x_4 of { happy_var_4 -> -	( do { let { Block tryItems _ = happy_var_3-                  ; catchStmts       = rev happy_var_4+	( do { let { tryItems   = mkBlockItems happy_var_3+                  ; catchStmts = rev happy_var_4                   }             ; when (null catchStmts) $                 throw $ ParserException (happy_var_1 <--> happy_var_3) $@@ -8948,7 +8944,7 @@ 	case happyOut52 happy_x_4 of { happy_var_4 ->  	case happyOut142 happy_x_6 of { happy_var_6 ->  	happyIn185-		 (let Block items _ = happy_var_6+		 (let items = mkBlockItems happy_var_6         in          ObjCSynchronized happy_var_4 items (happy_var_1 `srcspan` happy_var_6) 	) `HappyStk` happyRest}}}@@ -8960,7 +8956,7 @@ 	 =  case happyOutTok happy_x_1 of { happy_var_1 ->  	case happyOut142 happy_x_3 of { happy_var_3 ->  	happyIn185-		 (let Block items _ = happy_var_3+		 (let items = mkBlockItems happy_var_3         in          ObjCAutoreleasepool items (happy_var_1 `srcspan` happy_var_3) 	)}}@@ -8984,7 +8980,7 @@ 	case happyOut125 happy_x_5 of { happy_var_5 ->  	case happyOut142 happy_x_7 of { happy_var_7 ->  	happyIn186-		 (let Block items _ = happy_var_7+		 (let items = mkBlockItems happy_var_7         in         rcons (ObjCCatch (Just happy_var_5) items (happy_var_2 `srcspan` happy_var_7)) happy_var_1 	) `HappyStk` happyRest}}}}@@ -9002,7 +8998,7 @@ 	case happyOutTok happy_x_2 of { happy_var_2 ->  	case happyOut142 happy_x_7 of { happy_var_7 ->  	happyIn186-		 (let Block items _ = happy_var_7+		 (let items = mkBlockItems happy_var_7         in         rcons (ObjCCatch Nothing items (happy_var_2 `srcspan` happy_var_7)) happy_var_1 	) `HappyStk` happyRest}}}@@ -10528,9 +10524,9 @@ 	 =  case happyOut209 happy_x_1 of { happy_var_1 ->  	case happyOut142 happy_x_3 of { happy_var_3 ->  	happyIn224-		 (let Block stmts loc = happy_var_3+		 (let stmts = mkBlockItems happy_var_3         in-          ObjCMethDef happy_var_1 stmts (happy_var_1 `srcspan` loc)+          ObjCMethDef happy_var_1 stmts (happy_var_1 `srcspan` happy_var_3) 	)}}  happyReduce_917 = happySpecReduce_2  195# happyReduction_917@@ -10539,9 +10535,9 @@ 	 =  case happyOut209 happy_x_1 of { happy_var_1 ->  	case happyOut142 happy_x_2 of { happy_var_2 ->  	happyIn224-		 (let Block stmts loc = happy_var_2+		 (let stmts = mkBlockItems happy_var_2         in-          ObjCMethDef happy_var_1 stmts (happy_var_1 `srcspan` loc)+          ObjCMethDef happy_var_1 stmts (happy_var_1 `srcspan` happy_var_2) 	)}}  happyReduce_918 = happySpecReduce_1  195# happyReduction_918@@ -10582,7 +10578,7 @@ 	case happyOut227 happy_x_2 of { happy_var_2 ->  	case happyOut142 happy_x_3 of { happy_var_3 ->  	( do { assertCudaEnabled (happy_var_1 <--> happy_var_3) "To use lambda-expressions, enable support for CUDA"-          ; let Block items _ = happy_var_3+          ; let items = mkBlockItems happy_var_3           ; return $ Lambda happy_var_1 happy_var_2 items (happy_var_1 `srcspan` happy_var_3)           })}}} 	) (\r -> happyReturn (happyIn226 r))@@ -11685,6 +11681,14 @@  unless cuda_enabled $   throw $ ParserException loc $ text errMsg +mkBlock :: [BlockItem] -> SrcLoc -> Stm+mkBlock [BlockStm stm] _    = stm+mkBlock items          sloc = Block items sloc++mkBlockItems :: Stm -> [BlockItem]+mkBlockItems (Block items _) = items+mkBlockItems stm             = [BlockStm stm]+ mkCommentStm :: L T.Token -> Stm -> Stm mkCommentStm tok stm = Comment (getCOMMENT tok) stm (srclocOf tok) @@ -11728,8 +11732,9 @@     locOf (RApp xs ys) = locOf xs `mappend` locOf ys {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-}-{-# LINE 10 "<command-line>" #-}+{-# LINE 11 "<command-line>" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4  # 17 "/usr/include/stdc-predef.h" 3 4@@ -11775,7 +11780,26 @@   -{-# LINE 10 "<command-line>" #-}+{-# LINE 11 "<command-line>" #-}+{-# LINE 1 "/home/mainland/software/haskell-platform-7.10.3/build/ghc-bindist/local/lib/ghc-7.10.3/include/ghcversion.h" #-}++++++++++++++++++{-# LINE 11 "<command-line>" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp
language-c-quote.cabal view
@@ -1,5 +1,5 @@ name:          language-c-quote-version:       0.11.5+version:       0.11.5.1 cabal-version: >= 1.10 license:       BSD3 license-file:  LICENSE@@ -13,7 +13,7 @@ homepage:      http://www.drexel.edu/~mainland/ category:      Language synopsis:      C/CUDA/OpenCL/Objective-C quasiquoting library.-tested-with:   GHC==7.4.2, GHC==7.6.3, GHC==7.8.3+tested-with:   GHC==7.4.2, GHC==7.6.3, GHC==7.8.3, GHC==7.10.3  description:   This package provides a general parser for the C language, including most GCC@@ -24,8 +24,6 @@  extra-source-files:   Language/C/Syntax-instances.hs-  tests/unit/Objc.hs-  tests/unit/MainCPP.hs  flag full-haskell-antiquotes   description: Support full Haskell expressions/patterns in antiquotes. This@@ -95,6 +93,11 @@   type:             exitcode-stdio-1.0   hs-source-dirs:   tests/unit   main-is:          Main.hs+  other-modules:+    CUDA+    Objc+    MainCPP+   default-language: Haskell98    build-depends:
+ tests/unit/CUDA.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE QuasiQuotes #-}++module CUDA (cudaTests) where++import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit (Assertion, (@?=))++import Language.C.Quote.CUDA+import Language.C.Syntax+import Data.Loc (noLoc)++mkDeclarator params mutability = LambdaDeclarator (Params params False noLoc) mutability Nothing noLoc++mkIntroducer :: [CaptureListEntry] -> LambdaIntroducer+mkIntroducer mode = (LambdaIntroducer mode noLoc)++emptyLambda = lambdaByCapture []+lambdaByCapture captureMode = Lambda (mkIntroducer captureMode) Nothing [] noLoc+lambdaByCaptureBody captureMode statements = Lambda (mkIntroducer captureMode) Nothing statements noLoc+lambdaByCaptureParams captureMode params = Lambda (mkIntroducer captureMode) (Just $ mkDeclarator params False) [] noLoc++lambdaByParams params = Lambda (mkIntroducer []) (Just $ mkDeclarator params False) [] noLoc+mutableLambdaByParams params = Lambda (mkIntroducer []) (Just $ mkDeclarator params True) [] noLoc++cudaTests :: Test+cudaTests = testGroup "CUDA"+    $ map (testCase "lambda-expressions parsing") lambdas+  where+    lambdas :: [Assertion]+    lambdas = [ [cexp|[=] {}|] @?= lambdaByCapture [DefaultByValue]+              , [cexp|[&] {}|] @?= lambdaByCapture[DefaultByReference]+              , [cexp|[] {}|] @?= lambdaByCapture []+              , [cexp|[] {}|] @?= emptyLambda+              , [cexp|[] () {}|] @?= lambdaByParams []+              , [cexp|[] (int i) {}|] @?= lambdaByParams [param_int_i] +              , [cexp|[] (int i, double j) {}|] @?= lambdaByParams [param_int_i, param_double_h] +              , [cexp|[] ($param:param_int_i) {}|] @?= lambdaByParams [param_int_i] +              , [cexp|[] (int i) mutable {}|] @?= mutableLambdaByParams [param_int_i]  +              , [cexp|[&] (int i) {}|] @?= lambdaByCaptureParams [DefaultByReference] [param_int_i] +              , [cexp|[&] { $item:item_return_7 } |] @?= lambdaCapturingByRefAndReturning7+              , [cexp|[&] { return $exp:exp_7; } |] @?= lambdaCapturingByRefAndReturning7+              , [cexp|[]{}()|] @?= FnCall emptyLambda [] noLoc+              , [cexp|[](){}()|] @?= FnCall (lambdaByParams []) [] noLoc+              ]++    lambdaCapturingByRefAndReturning7 = lambdaByCaptureBody [DefaultByReference] [item_return_7]+    exp_7 = [cexp|7|]+    item_return_7 = [citem|return 7;|]+    param_int_i = [cparam|int i|]+    param_double_h = [cparam|double j|]